re PR fortran/37228 (F2008: Support g0.<d> edit descriptor)

2008-09-01  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/37228
	* io.c (check_format): Allow specifying precision with g0 format.

2008-09-01  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/37301
	PR libfortran/37228
	* io/io.h (write_real_g0): Declare new function to handle g0.d format.
	* io/transfer.c (formatted_transfer_scalar): Use new function.
	* io/format.c (parse_format_list): Enable g0.d.
	* io/write.c (write_a_char4): Delete unused var.
	(set_fnode_default): New function to set the default fnode w, d, and e
	factored from write_real. (write_real): Use new factored function.
	(write_real_g0): New function that sets d to that passed by g0.d format
	specifier and set format to ES.  Default values for w and e are used
	from the new function, set_fnode_default.

2008-09-01  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/37228
	* gfortran.dg/fmt_g0_4.f08: Revised test.

From-SVN: r139886

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a878f0b7d1e69f11e4ecda7caa0ad6b33caf6b0b..213af61193ac77d4e6326394b3d6400ff083bbe5 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2008-09-01  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR fortran/37228
+       * io.c (check_format): Allow specifying precision with g0 format.
+
 2008-09-02  Daniel Kraft  <d@domob.eu>
 
        * gfortran.h (struct gfc_namespace): New member `implicit_loc'.

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 979dfc20aa32b016d23f2d23746e7ae863735a51..298c758ac0cd6f0a80d34aa2dcb7b54757234d15 100644 (file)
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -483,7 +483,6 @@ check_format (bool is_input)
                                      " at %L");
   const char *unexpected_end     = _("Unexpected end of format string");
   const char *zero_width         = _("Zero width in format descriptor");
-  const char *g0_precision     = _("Specifying precision with G0 not allowed");
 
   const char *error;
   format_token t, u;
@@ -701,27 +700,25 @@ data_desc:
              error = zero_width;
              goto syntax;
            }
-
          if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: 'G0' in "
                              "format at %C") == FAILURE)
            return FAILURE;
+         u = format_lex ();
+         if (u != FMT_PERIOD)
+           {
+             saved_token = u;
+             break;
+           }
 
          u = format_lex ();
-          if (u == FMT_PERIOD)
+         if (u == FMT_ERROR)
+           goto fail;
+         if (u != FMT_POSINT)
            {
-             error = g0_precision;
+             error = posint_required;
              goto syntax;
            }
-         saved_token = u;
-         goto between_desc;
-       }
-
-      if (u == FMT_ERROR)
-       goto fail;
-      if (u != FMT_POSINT)
-       {
-         error = posint_required;
-         goto syntax;
+         break;
        }
 
       u = format_lex ();

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 55577332b3eff7802a685c964a4c9eda63f65ff6..83d310fba7bbbd93747c5502c2828ce48575bf30 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-09-01  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR fortran/37228
+       * gfortran.dg/fmt_g0_4.f08: Revised test.
+
 2008-09-02  Daniel Kraft  <d@domob.eu>
 
        * gfortran.dg/abstract_type_1.f90: New test.

diff --git a/gcc/testsuite/gfortran.dg/fmt_g0_4.f08 b/gcc/testsuite/gfortran.dg/fmt_g0_4.f08
index 149b1aa400a095fbcec7369972d52dd6bf4efb01..500117ec80f7ff74b057abb0ed971eab90a63edc 100644 (file)
--- a/gcc/testsuite/gfortran.dg/fmt_g0_4.f08
+++ b/gcc/testsuite/gfortran.dg/fmt_g0_4.f08
@@ -1,5 +1,15 @@
 ! { dg-do compile }
 ! { dg-options "-std=f2008" }
 ! PR36725 Compile time error for g0 edit descriptor
-print '(g0.9)', 0.1 ! { dg-error "Specifying precision" }
+character(30) :: line
+write(line, '(g0.3)') 0.1
+if (line.ne."      1.000E-01") call abort
+write(line, '(g0.9)') 1.0
+if (line.ne."1.000000000E+00") call abort
+write(line, '(g0.5)') 29.23
+if (line.ne."    2.92300E+01") call abort
+write(line, '(g0.8)') -28.4
+if (line.ne."-2.83999996E+01") call abort
+write(line, '(g0.8)') -0.0001
+if (line.ne."-9.99999975E-05") call abort
 end

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 8670d461c67afa515f024bf9f78de6bcb60852d9..1e65eb111d885b9cf4928ca4879333e88955d533 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,17 @@
+2008-09-01  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libfortran/37301
+       PR libfortran/37228
+       * io/io.h (write_real_g0): Declare new function to handle g0.d format.
+       * io/transfer.c (formatted_transfer_scalar): Use new function.
+       * io/format.c (parse_format_list): Enable g0.d.
+       * io/write.c (write_a_char4): Delete unused var.
+       (set_fnode_default): New function to set the default fnode w, d, and e
+       factored from write_real. (write_real): Use new factored function.
+       (write_real_g0): New function that sets d to that passed by g0.d format
+       specifier and set format to ES.  Default values for w and e are used
+       from the new function, set_fnode_default.
+
 2008-09-01  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        * runtime/error.c: Fix cast for printf.

diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index 02ce2913bd20d0ce7af4bc1afb51f6379c82ef38..667797fd1c09f7bda145a3a17b533805beec84e6 100644 (file)
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -735,6 +735,20 @@ parse_format_list (st_parameter_dt *dtp)
              goto finished;
            }
          tail->u.real.w = 0;
+         u = format_lex (fmt);
+         if (u != FMT_PERIOD)
+           {
+             fmt->saved_token = u;
+             break;
+           }
+
+         u = format_lex (fmt);
+         if (u != FMT_POSINT)
+           {
+             fmt->error = posint_required;
+             goto finished;
+           }
+         tail->u.real.d = fmt->value;
          break;
        }
       if (t == FMT_F || dtp->u.p.mode == WRITING)

diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index cb7147db39868f4f0ca59a3d5ae50b6145691855..228372a9afaf6d621a1c90596ae15681793a549d 100644 (file)
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -940,6 +940,9 @@ internal_proto(write_o);
 extern void write_real (st_parameter_dt *, const char *, int);
 internal_proto(write_real);
 
+extern void write_real_g0 (st_parameter_dt *, const char *, int, int);
+internal_proto(write_real_g0);
+
 extern void write_x (st_parameter_dt *, int, int);
 internal_proto(write_x);
 

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index fd63139146ee953a5886cb884d4534a94156faf1..c810f4d7bea5f8a8fec74d1548bbf5ff0e6e8e4f 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -1213,7 +1213,12 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
                break;
              case BT_REAL:
                if (f->u.real.w == 0)
-                 write_real (dtp, p, kind);
+                 {
+                   if (f->u.real.d == 0)
+                     write_real (dtp, p, kind);
+                   else
+                     write_real_g0 (dtp, p, kind, f->u.real.d);
+                 }
                else
                  write_d (dtp, f, p, kind);
                break;

diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 65210bcbe1fc9d13693513c47b0b5e09092e72ad..414a69e3a6c8178c4f09376f20a54be54f600b30 100644 (file)
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -301,7 +301,7 @@ write_a_char4 (st_parameter_dt *dtp, const fnode *f, const char *source, int len
   if (is_stream_io (dtp))
     {
       const char crlf[] = "\r\n";
-      int i, j, bytes;
+      int i, bytes;
       gfc_char4_t *qq;
       bytes = 0;
 
@@ -952,43 +952,64 @@ write_character (st_parameter_dt *dtp, const char *source, int kind, int length)
 }
 
 
-/* Output a real number with default format.
-   This is 1PG14.7E2 for REAL(4), 1PG23.15E3 for REAL(8),
-   1PG28.19E4 for REAL(10) and 1PG43.34E4 for REAL(16).  */
+/* Set an fnode to default format.  */
 
-void
-write_real (st_parameter_dt *dtp, const char *source, int length)
+static void
+set_fnode_default (st_parameter_dt *dtp, fnode *f, int length)
 {
-  fnode f ;
-  int org_scale = dtp->u.p.scale_factor;
-  f.format = FMT_G;
-  dtp->u.p.scale_factor = 1;
+  f->format = FMT_G;
   switch (length)
     {
     case 4:
-      f.u.real.w = 15;
-      f.u.real.d = 8;
-      f.u.real.e = 2;
+      f->u.real.w = 15;
+      f->u.real.d = 8;
+      f->u.real.e = 2;
       break;
     case 8:
-      f.u.real.w = 25;
-      f.u.real.d = 17;
-      f.u.real.e = 3;
+      f->u.real.w = 25;
+      f->u.real.d = 17;
+      f->u.real.e = 3;
       break;
     case 10:
-      f.u.real.w = 29;
-      f.u.real.d = 20;
-      f.u.real.e = 4;
+      f->u.real.w = 29;
+      f->u.real.d = 20;
+      f->u.real.e = 4;
       break;
     case 16:
-      f.u.real.w = 44;
-      f.u.real.d = 35;
-      f.u.real.e = 4;
+      f->u.real.w = 44;
+      f->u.real.d = 35;
+      f->u.real.e = 4;
       break;
     default:
       internal_error (&dtp->common, "bad real kind");
       break;
     }
+}
+/* Output a real number with default format.
+   This is 1PG14.7E2 for REAL(4), 1PG23.15E3 for REAL(8),
+   1PG28.19E4 for REAL(10) and 1PG43.34E4 for REAL(16).  */
+
+void
+write_real (st_parameter_dt *dtp, const char *source, int length)
+{
+  fnode f ;
+  int org_scale = dtp->u.p.scale_factor;
+  dtp->u.p.scale_factor = 1;
+  set_fnode_default (dtp, &f, length);
+  write_float (dtp, &f, source , length);
+  dtp->u.p.scale_factor = org_scale;
+}
+
+
+void
+write_real_g0 (st_parameter_dt *dtp, const char *source, int length, int d)
+{
+  fnode f ;
+  int org_scale = dtp->u.p.scale_factor;
+  dtp->u.p.scale_factor = 1;
+  set_fnode_default (dtp, &f, length);
+  f.format = FMT_ES;
+  f.u.real.d = d;
   write_float (dtp, &f, source , length);
   dtp->u.p.scale_factor = org_scale;
 }