re PR libfortran/90374 (Fortran 2018: Support d0.d, e0.d, es0.d, en0.d, g0.d and ew.d e0 edit descriptors for output)

2019-11-06  Jerry DeLisle  <jvdelisle@gcc.ngu.org>

	PR fortran/90374
	* io.c (check_format): Allow zero width for D, E, EN, and ES
	specifiers as default and when -std=F2018 is given. Retain
	existing errors when using the -fdec family of flags.

	* libgfortran/io/format.c (parse_format_list): Relax format checking for
	zero width as default and when -std=f2018.
	io/format.h (format_token): Move definition to io.h.
	io/io.h (format_token): Add definition here to allow access to
	this definition at higher levels. Rename the declaration of
	write_real_g0 to write_real_w0 and add a new format_token
	argument, allowing higher level functions to pass in the
	token for handling of g0 vs the other zero width specifiers.
	io/transfer.c (formatted_transfer_scalar_write): Add checks for
	zero width and call write_real_w0 to handle it.
	io/write.c (write_real_g0): Remove.
	(write_real_w0): Add new, same as previous write_real_g0 except
	check format token to handle the g0 case.

	* gfortran.dg/fmt_error_10.f: Modify for new constraints.
	* gfortran.dg/fmt_error_7.f: Add dg-options "-std=f95".
	* gfortran.dg/fmt_error_9.f: Modify for new constraints.
	* gfortran.dg/fmt_zero_width.f90: New test.

From-SVN: r277905

7 files changed, 83 insertions, 11 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f9f9da2..5023949 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2019-11-06  Jerry DeLisle  <jvdelisle@gcc.ngu.org>
+
+	PR fortran/90374
+	* io.c (check_format): Allow zero width for D, E, EN, and ES
+	specifiers as default and when -std=F2018 is given. Retain
+	existing errors when using the -fdec family of flags.
+	
 2019-11-03  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/92113
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index b969a1a..57a3fdd 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -922,19 +922,38 @@ data_desc:
 
       if (u != FMT_POSINT)
 	{
+	  if (flag_dec)
+	    {
+	      if (flag_dec_format_defaults)
+		{
+		  /* Assume a default width based on the variable size.  */
+		  saved_token = u;
+		  break;
+		}
+	      else
+		{
+		  gfc_error ("Positive width required in format "
+			     "specifier %s at %L", token_to_string (t),
+			     &format_locus);
+		  saved_token = u;
+		  goto fail;
+		}
+	    }
+
+	  format_locus.nextc += format_string_pos;
+	  if (!gfc_notify_std (GFC_STD_F2018,
+			       "positive width required at %L",
+			       &format_locus))
+	    {
+	      saved_token = u;
+	      goto fail;
+	    }
 	  if (flag_dec_format_defaults)
 	    {
 	      /* Assume a default width based on the variable size.  */
 	      saved_token = u;
 	      break;
 	    }
-
-	  format_locus.nextc += format_string_pos;
-	  gfc_error ("Positive width required in format "
-			 "specifier %s at %L", token_to_string (t),
-			 &format_locus);
-	  saved_token = u;
-	  goto fail;
 	}
 
       u = format_lex ();
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e404453..6bb85a3 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2019-11-06  Jerry DeLisle  <jvdelisle@gcc.ngu.org>
+
+	PR fortran/90374
+	* gfortran.dg/fmt_error_10.f: Modify for new constraints.
+	* gfortran.dg/fmt_error_7.f: Add dg-options "-std=f95".
+	* gfortran.dg/fmt_error_9.f: Modify for new constraints.
+	* gfortran.dg/fmt_zero_width.f90: New test.
+
 2019-11-07  Joseph Myers  <joseph@codesourcery.com>
 
 	* gcc.dg/asm-wide-1.c, gcc.dg/diagnostic-token-ranges.c,
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_10.f b/gcc/testsuite/gfortran.dg/fmt_error_10.f
index 7ea6aec..6e1a5f6 100644
--- a/gcc/testsuite/gfortran.dg/fmt_error_10.f
+++ b/gcc/testsuite/gfortran.dg/fmt_error_10.f
@@ -18,9 +18,9 @@
 
       str = '(1pd0.15)'
       write (line,str,iostat=istat, iomsg=msg) 1.0d0
-      if (istat.ne.5006 .or. msg(1:15).ne."Positive width ") STOP 5
+      if (line.ne."1.000000000000000") STOP 5
       read (*,str,iostat=istat, iomsg=msg) x
-      if (istat.ne.5006 .or. msg(1:15).ne."Positive width ") STOP 6
+      if (istat.ne.5006 .or. msg(1:10).ne."Zero width") STOP 6
       if (x.ne.555.25) STOP 7
       
       write (line,'(1pd24.15e11.3)') 1.0d0, 1.234
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_7.f b/gcc/testsuite/gfortran.dg/fmt_error_7.f
index 9b5fba9..3937c8f 100644
--- a/gcc/testsuite/gfortran.dg/fmt_error_7.f
+++ b/gcc/testsuite/gfortran.dg/fmt_error_7.f
@@ -1,7 +1,9 @@
 ! { dg-do compile }
+! { dg-options "-std=f95" }
+
 ! PR37446 Diagnostic of edit descriptors, esp. EN
       character(40) :: fmt_string
       write(*, '(1P,2E12.4)') 1.0
-      write(*,'(EN)') 5.0 ! { dg-error "Positive width required" }
+      write(*,'(EN)') 5.0 ! { dg-error "positive width required" }
       write(*,'("abcdefg",EN6,"hjjklmnop")') 5.0 ! { dg-error "Period required" }
       end
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_9.f b/gcc/testsuite/gfortran.dg/fmt_error_9.f
index 1d67750..40c73599 100644
--- a/gcc/testsuite/gfortran.dg/fmt_error_9.f
+++ b/gcc/testsuite/gfortran.dg/fmt_error_9.f
@@ -16,7 +16,7 @@
       write (line,str,iostat=istat, iomsg=msg) 1.0d0
       if (istat.ne.0) STOP 3
       read (*,str,iostat=istat, iomsg=msg) x
-      if (istat.ne.5006 .or. msg(1:15).ne."Positive width ") STOP 4
+      if (istat.ne.5006 .or. msg(1:10).ne."Zero width") STOP 4
       if (x.ne.555.25) STOP 5
       
       write (line,'(1pd24.15e11.3)') 1.0d0, 1.234
diff --git a/gcc/testsuite/gfortran.dg/fmt_zero_width.f90 b/gcc/testsuite/gfortran.dg/fmt_zero_width.f90
new file mode 100644
index 0000000..093c0a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_zero_width.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! PR90374 "5.5 d0.d, e0.d, es0.d, en0.d, g0.d and ew.d edit descriptors
+program pr90374
+  real(4) :: rn
+  character(32) :: afmt, aresult
+  real(8) :: one = 1.0D0, zero = 0.0D0, nan, pinf, minf
+
+  nan = zero/zero
+  rn = 0.00314_4
+  afmt = "(D0.3)"
+  write (aresult,fmt=afmt) rn
+  if (aresult /= "0.314D-02") stop 12
+  afmt = "(E0.10)"
+  write (aresult,fmt=afmt) rn
+  if (aresult /= "0.3139999928E-02") stop 15
+  afmt = "(ES0.10)"
+  write (aresult,fmt=afmt) rn
+  if (aresult /= "3.1399999280E-03") stop 18
+  afmt = "(EN0.10)"
+  write (aresult,fmt=afmt) rn
+  if (aresult /= "3.1399999280E-03") stop 21
+  afmt = "(G0.10)"
+  write (aresult,fmt=afmt) rn
+  if (aresult /= "0.3139999928E-02") stop 24
+  write (aresult,fmt="(D0.3)") rn
+  if (aresult /= "0.314D-02") stop 26
+  write (aresult,fmt="(E0.10)") rn
+  if (aresult /= "0.3139999928E-02") stop 28
+  write (aresult,fmt="(ES0.10)") rn
+  if (aresult /= "3.1399999280E-03") stop 30
+  write (aresult,fmt="(EN0.10)") rn
+  if (aresult /= "3.1399999280E-03") stop 32
+  write (aresult,fmt="(G0.10)") rn
+  if (aresult /= "0.3139999928E-02") stop 34
+
+end