[Bug fortran/83191] [7/8 Regression] Writing a namelist with repeated complex numbers

dominiq at lps dot ens.fr gcc-bugzilla@gcc.gnu.org
Tue Nov 28 22:57:00 GMT 2017


https://gcc.gnu.org/bugzilla/show_bug.cgi?id=83191

--- Comment #3 from Dominique d'Humieres <dominiq at lps dot ens.fr> ---
The following patch does the trick:

--- ../_clean/libgfortran/io/write.c    2017-11-22 20:37:44.000000000 +0100
+++ libgfortran/io/write.c      2017-11-28 23:45:55.000000000 +0100
@@ -1552,7 +1552,7 @@ select_string (st_parameter_dt *dtp, con
               int kind)
 {
   char *result;
-  *size = size_from_kind (dtp, f, kind) + f->u.real.d;
+  *size = size_from_kind (dtp, f, kind) + f->u.real.d + 1;
   if (*size > BUF_STACK_SZ)
      result = xmalloc (*size);
   else
@@ -1769,7 +1769,8 @@ write_real_g0 (st_parameter_dt *dtp, con


 static void
-write_complex (st_parameter_dt *dtp, const char *source, int kind, size_t
size)
+write_complex (st_parameter_dt *dtp, const char *source, int kind, size_t
size,
+               bool justify)
 {
   char semi_comma =
        dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? ',' : ';';
@@ -1809,9 +1810,12 @@ write_complex (st_parameter_dt *dtp, con
                            precision, buf_size, result1, &res_len1);
   get_float_string (dtp, &f, source + size / 2 , kind, 0, buffer,
                            precision, buf_size, result2, &res_len2);
-  lblanks = width - res_len1 - res_len2 - 3;
+  if (justify)
+    {
+      lblanks = width - res_len1 - res_len2 - 3;

-  write_x (dtp, lblanks, lblanks);
+      write_x (dtp, lblanks, lblanks);
+    }
   write_char (dtp, '(');
   write_float_string (dtp, result1, res_len1);
   write_char (dtp, semi_comma);
@@ -1889,7 +1893,7 @@ list_formatted_write_scalar (st_paramete
       write_real (dtp, p, kind);
       break;
     case BT_COMPLEX:
-      write_complex (dtp, p, kind, size);
+      write_complex (dtp, p, kind, size, true);
       break;
     case BT_CLASS:
       {
@@ -2202,7 +2206,7 @@ nml_write_obj (st_parameter_dt *dtp, nam
           case BT_COMPLEX:
              dtp->u.p.no_leading_blank = 0;
              num++;
-              write_complex (dtp, p, len, obj_size);
+              write_complex (dtp, p, len, obj_size, false);
               break;

            case BT_DERIVED:


More information about the Gcc-bugs mailing list