re PR libfortran/90374 (Fortran 2018: Support d0.d, e0.d, es0.d, en0.d, g0.d and...

	PR fortran/90374
	* io.c (check_format): Allow zero width expoenent with e0.

	* io/format.c (parse_format_list): Relax format checking to allow
	e0 exponent specifier.

	* gfortran.dg/fmt_zero_width.f90: Update test.

From-SVN: r278817

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4cf6e9e3d1a7518d1998199501e3c1baf0df93ea..b2673866bee9f25e59b0be0f54e412b364f47c75 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2019-11-28  Jerry DeLisle  <jvdelisle@gcc.ngu.org>
+
+       PR fortran/90374
+       * io.c (check_format): Allow zero width expoenent with e0.
+
 2019-11-27  Jakub Jelinek  <jakub@redhat.com>
 
        PR fortran/91944

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 57a3fdd5152733d90b10d01501400efb1ad0032b..8cf8c2d96af09bff9902e9e76d67f5504c5ae21f 100644 (file)
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -1007,9 +1007,22 @@ data_desc:
            goto fail;
          if (u != FMT_POSINT)
            {
-             error = G_("Positive exponent width required in format string "
-                        "at %L");
-             goto syntax;
+             if (u == FMT_ZERO)
+               {
+                 if (!gfc_notify_std (GFC_STD_F2018,
+                                     "Positive exponent width required in "
+                                     "format string at %L", &format_locus))
+                   {
+                     saved_token = u;
+                     goto fail;
+                   }
+               }
+             else
+               {
+                 error = G_("Positive exponent width required in format "
+                            "string at %L");
+                 goto syntax;
+               }
            }
        }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index eeb4379b5d066dbfc93924dad53336d6de0ea5c8..65e7ffc3c23d25ef0e9cfecd6691000164ddd613 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-11-28  Jerry DeLisle  <jvdelisle@gcc.ngu.org>
+
+       PR fortran/90374
+       * gfortran.dg/fmt_zero_width.f90: Update test.
+
 2019-11-28  Martin Jambor  <mjambor@suse.cz>
 
        PR ipa/92697

diff --git a/gcc/testsuite/gfortran.dg/fmt_zero_width.f90 b/gcc/testsuite/gfortran.dg/fmt_zero_width.f90
index 093c0a44c348c97893f709d0fbb13bf09cc36bde..640b6735c65a72774528cc1924a3a23854356a29 100644 (file)
--- a/gcc/testsuite/gfortran.dg/fmt_zero_width.f90
+++ b/gcc/testsuite/gfortran.dg/fmt_zero_width.f90
@@ -1,11 +1,11 @@
 ! { dg-do run }
 ! PR90374 "5.5 d0.d, e0.d, es0.d, en0.d, g0.d and ew.d edit descriptors
 program pr90374
+  implicit none
   real(4) :: rn
   character(32) :: afmt, aresult
-  real(8) :: one = 1.0D0, zero = 0.0D0, nan, pinf, minf
+  real(8) :: one = 1.0D0, zero = 0.0D0, pinf, minf
 
-  nan = zero/zero
   rn = 0.00314_4
   afmt = "(D0.3)"
   write (aresult,fmt=afmt) rn
@@ -22,15 +22,19 @@ program pr90374
   afmt = "(G0.10)"
   write (aresult,fmt=afmt) rn
   if (aresult /= "0.3139999928E-02") stop 24
+  afmt = "(E0.10e0)"
+  write (aresult,fmt=afmt) rn
+  if (aresult /= "0.3139999928E-02") stop 27
   write (aresult,fmt="(D0.3)") rn
-  if (aresult /= "0.314D-02") stop 26
+  if (aresult /= "0.314D-02") stop 29
   write (aresult,fmt="(E0.10)") rn
-  if (aresult /= "0.3139999928E-02") stop 28
+  if (aresult /= "0.3139999928E-02") stop 31
   write (aresult,fmt="(ES0.10)") rn
-  if (aresult /= "3.1399999280E-03") stop 30
+  if (aresult /= "3.1399999280E-03") stop 33
   write (aresult,fmt="(EN0.10)") rn
-  if (aresult /= "3.1399999280E-03") stop 32
+  if (aresult /= "3.1399999280E-03") stop 35
   write (aresult,fmt="(G0.10)") rn
-  if (aresult /= "0.3139999928E-02") stop 34
-
+  if (aresult /= "0.3139999928E-02") stop 37
+  write (aresult,fmt="(E0.10e0)") rn
+  if (aresult /= "0.3139999928E-02") stop 39
 end

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 91768c0a00f16f72b8b5a68a7e08633f3d7c7e0b..74e36acd1d9bdee2a45b706519d114ca202944f7 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,7 +1,13 @@
+2019-11-28  Jerry DeLisle  <jvdelisle@gcc.ngu.org>
+
+       PR fortran/90374
+       * io/format.c (parse_format_list): Relax format checking to allow
+       e0 exponent specifier.
+
 2019-11-24  Jerry DeLisle  <jvdelisle@gcc.ngu.org>
 
        PR fortran/92100
-       io/transfer.c (data_transfer_init_worker): Use fbuf_reset
+       * io/transfer.c (data_transfer_init_worker): Use fbuf_reset
        instead of fbuf_flush before the seek. Note that fbuf_reset
        calls fbuf_flush and adjusts fbuf pointers.
 

diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index b33620815d5392174dcd840b8ce0159672bb1cc2..dd448c83e87134250d660ab525013e92ee249e1d 100644 (file)
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -1027,11 +1027,17 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
        {
          t = format_lex (fmt);
          if (t != FMT_POSINT)
-           {
-             fmt->error = "Positive exponent width required in format";
-             goto finished;
-           }
-
+           if (t == FMT_ZERO)
+             {
+               notify_std (&dtp->common, GFC_STD_F2018,
+                           "Positive exponent width required");
+             }
+           else
+             {
+               fmt->error = "Positive exponent width required in "
+                            "format string at %L";
+               goto finished;
+             }
          tail->u.real.e = fmt->value;
        }
 

diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index daa16679f53261ac81e80118d7cbe815f5657e9b..ce6aec8311479e8665526c0a4e7ce519a311c8e8 100644 (file)
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -482,7 +482,7 @@ build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
       for (i = abs (e); i >= 10; i /= 10)
        edigits++;
 
-      if (f->u.real.e < 0)
+      if (f->u.real.e <= 0)
        {
          /* Width not specified.  Must be no more than 3 digits.  */
          if (e > 999 || e < -999)