fortran/89100: Default widths with -fdec-format-defaults

gcc/fortran ChangeLog:

2019-05-22  Jeff Law  <law@redhat.com>
            Mark Eggleston  <mark.eggleston@codethink.com>

        PR fortran/89100
        * gfortran.texi: Add Default widths for F, G and I format
        descriptors to Extensions section.
        * invoke.texi: Add -fdec-format-defaults
        * io.c (check_format): Use default widths for i, f and g when
        flag_dec_format_defaults is enabled.
        * lang.opt: Add new option.
        * options.c (set_dec_flags): Add SET_BITFLAG for
        flag_dec_format_defaults.


gcc/testsuite ChangeLog:

2019-05-22  Mark Eggleston  <mark.eggleston@codethink.com>

        PR fortran/89100
        * gfortran.dg/fmt_f_default_field_width_1.f90: New test.
        * gfortran.dg/fmt_f_default_field_width_2.f90: New test.
        * gfortran.dg/fmt_f_default_field_width_3.f90: New test.
        * gfortran.dg/fmt_g_default_field_width_1.f90: New test.
        * gfortran.dg/fmt_g_default_field_width_2.f90: New test.
        * gfortran.dg/fmt_g_default_field_width_3.f90: New test.
        * gfortran.dg/fmt_i_default_field_width_1.f90: New test.
        * gfortran.dg/fmt_i_default_field_width_2.f90: New test.
        * gfortran.dg/fmt_i_default_field_width_3.f90: New test.


libgfortran ChangeLog:

2019-05-22  Jeff Law  <law@redhat.com>

        PR fortran/89100
        * io/format.c (parse_format_list): set default width when the
        IOPARM_DT_DEC_EXT flag is set for i, f and g.
        * io/io.h: add default_width_for_integer, default_width_for_float
        and default_precision_for_float.
        * io/write.c (write_boz): extra parameter giving length of data
        corresponding to the type's kind.
        (write_b): pass data length as extra parameter in calls to
        write_boz.
        (write_o): pass data length as extra parameter in calls to
        write_boz.
        (write_z): pass data length as extra parameter in calls to
        write_boz.
        (size_from_kind): also set size is default width is set.
        * io/write_float.def (build_float_string): new paramter inserted
        before result parameter. If default width use values passed
        instead of the values in fnode.
        (FORMAT_FLOAT): macro modified to check for default width and
        calls to build_float_string to pass in default width.
        (get_float_string): set width and precision to defaults when
        needed.

From-SVN: r271511

1 files changed, 13 insertions, 9 deletions

diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index c8811e2..4ef3556 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -685,9 +685,8 @@ write_l (st_parameter_dt *dtp, const fnode *f, char *source, int len)
   p[wlen - 1] = (n) ? 'T' : 'F';
 }
 
-
 static void
-write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n)
+write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n, int len)
 {
   int w, m, digits, nzero, nblank;
   char *p;
@@ -720,6 +719,9 @@ write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n)
   /* Select a width if none was specified.  The idea here is to always
      print something.  */
 
+  if (w == DEFAULT_WIDTH)
+    w = default_width_for_integer (len);
+
   if (w == 0)
     w = ((digits < m) ? m : digits);
 
@@ -846,6 +848,8 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
 
   /* Select a width if none was specified.  The idea here is to always
      print something.  */
+  if (w == DEFAULT_WIDTH)
+    w = default_width_for_integer (len);
 
   if (w == 0)
     w = ((digits < m) ? m : digits) + nsign;
@@ -1206,13 +1210,13 @@ write_b (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
   if (len > (int) sizeof (GFC_UINTEGER_LARGEST))
     {
       p = btoa_big (source, itoa_buf, len, &n);
-      write_boz (dtp, f, p, n);
+      write_boz (dtp, f, p, n, len);
     }
   else
     {
       n = extract_uint (source, len);
       p = btoa (n, itoa_buf, sizeof (itoa_buf));
-      write_boz (dtp, f, p, n);
+      write_boz (dtp, f, p, n, len);
     }
 }
 
@@ -1227,13 +1231,13 @@ write_o (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
   if (len > (int) sizeof (GFC_UINTEGER_LARGEST))
     {
       p = otoa_big (source, itoa_buf, len, &n);
-      write_boz (dtp, f, p, n);
+      write_boz (dtp, f, p, n, len);
     }
   else
     {
       n = extract_uint (source, len);
       p = otoa (n, itoa_buf, sizeof (itoa_buf));
-      write_boz (dtp, f, p, n);
+      write_boz (dtp, f, p, n, len);
     }
 }
 
@@ -1247,13 +1251,13 @@ write_z (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
   if (len > (int) sizeof (GFC_UINTEGER_LARGEST))
     {
       p = ztoa_big (source, itoa_buf, len, &n);
-      write_boz (dtp, f, p, n);
+      write_boz (dtp, f, p, n, len);
     }
   else
     {
       n = extract_uint (source, len);
       p = gfc_xtoa (n, itoa_buf, sizeof (itoa_buf));
-      write_boz (dtp, f, p, n);
+      write_boz (dtp, f, p, n, len);
     }
 }
 
@@ -1491,7 +1495,7 @@ size_from_kind (st_parameter_dt *dtp, const fnode *f, int kind)
 {
   int size;
 
-  if (f->format == FMT_F && f->u.real.w == 0)
+  if ((f->format == FMT_F && f->u.real.w == 0) || f->u.real.w == DEFAULT_WIDTH)
     {
       switch (kind)
       {