diff mbox series

Fortran : rejected f0.d edit descriptor PR96436

Message ID f29c4c1b-d9d8-154e-b4bf-e4aac30ad0a5@codethink.co.uk
State New
Headers show
Series Fortran : rejected f0.d edit descriptor PR96436 | expand

Commit Message

Mark Eggleston Aug. 17, 2020, 7:31 a.m. UTC 
Please find attached a patch for PR96436.

OK to commit?

[PATCH] Fortran  : rejected f0.d edit descriptor PR96436

Zero length f format descriptors are valid for Fortran 95 and
later.  For g format descriptors from Fortran 2008 and later.
Finally for D, E, EN and ES for Fortran 2018 and later.

2020-08-10  Mark Eggleston <markeggleston@gcc.gnu.org>

libgfortran/io/

     PR fortran/96436
     * format.c (parse_format_list):  Add new local variable
     "standard" to hold the required standard to check. If the
     format width is zero select standard depending on descriptor.
     Call notification_std using the new standard variable.

2020-08-10  Mark Eggleston <markeggleston@gcc.gnu.org>

gcc/testsuite/

     PR fortran/96436
     * gfortran.dg/pr96436_1.f90
     * gfortran.dg/pr96436_2.f90
     * gfortran.dg/pr96436_3.f90
     * gfortran.dg/pr96436_4.f90
     * gfortran.dg/pr96436_5.f90
     * gfortran.dg/pr96436_6.f90
     * gfortran.dg/pr96436_7.f90
     * gfortran.dg/pr96436_8.f90
     * gfortran.dg/pr96436_9.f90
     * gfortran.dg/pr96436_10.f90

Comments

Jerry D Aug. 18, 2020, 11:37 p.m. UTC | #1 
On 8/17/20 12:31 AM, Mark Eggleston wrote:
> Please find attached a patch for PR96436.
>
> OK to commit?
>
Looks good to me.  Thanks for fixing this.

Regards,

Jerry
diff mbox series

Patch

From 9f60ccd71e0c675b48d6614141d1aeddaa863191 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Tue, 4 Aug 2020 14:10:08 +0100
Subject: [PATCH] Fortran  : rejected f0.d edit descriptor PR96436

Zero length f format descriptors are valid for Fortran 95 and
later.  For g format descriptors from Fortran 2008 and later.
Finally for D, E, EN and ES for Fortran 2018 and later.

2020-08-10  Mark Eggleston  <markeggleston@gcc.gnu.org>

libgfortran/io/

	PR fortran/96436
	* format.c (parse_format_list):  Add new local variable
	"standard" to hold the required standard to check. If the
	format width is zero select standard depending on descriptor.
	Call notification_std using the new standard variable.

2020-08-10  Mark Eggleston  <markeggleston@gcc.gnu.org>

gcc/testsuite/

	PR fortran/96436
	* gfortran.dg/pr96436_1.f90
	* gfortran.dg/pr96436_2.f90
	* gfortran.dg/pr96436_3.f90
	* gfortran.dg/pr96436_4.f90
	* gfortran.dg/pr96436_5.f90
	* gfortran.dg/pr96436_6.f90
	* gfortran.dg/pr96436_7.f90
	* gfortran.dg/pr96436_8.f90
	* gfortran.dg/pr96436_9.f90
	* gfortran.dg/pr96436_10.f90
---
 gcc/testsuite/gfortran.dg/pr96436_1.f90  | 10 ++++++++++
 gcc/testsuite/gfortran.dg/pr96436_10.f90 | 10 ++++++++++
 gcc/testsuite/gfortran.dg/pr96436_2.f90  | 10 ++++++++++
 gcc/testsuite/gfortran.dg/pr96436_3.f90  | 13 +++++++++++++
 gcc/testsuite/gfortran.dg/pr96436_4.f90  | 25 +++++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/pr96436_5.f90  | 25 +++++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/pr96436_6.f90  | 10 ++++++++++
 gcc/testsuite/gfortran.dg/pr96436_7.f90  | 10 ++++++++++
 gcc/testsuite/gfortran.dg/pr96436_8.f90  | 10 ++++++++++
 gcc/testsuite/gfortran.dg/pr96436_9.f90  | 10 ++++++++++
 libgfortran/io/format.c                  | 10 +++++++++-
 11 files changed, 142 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr96436_1.f90
 create mode 100644 gcc/testsuite/gfortran.dg/pr96436_10.f90
 create mode 100644 gcc/testsuite/gfortran.dg/pr96436_2.f90
 create mode 100644 gcc/testsuite/gfortran.dg/pr96436_3.f90
 create mode 100644 gcc/testsuite/gfortran.dg/pr96436_4.f90
 create mode 100644 gcc/testsuite/gfortran.dg/pr96436_5.f90
 create mode 100644 gcc/testsuite/gfortran.dg/pr96436_6.f90
 create mode 100644 gcc/testsuite/gfortran.dg/pr96436_7.f90
 create mode 100644 gcc/testsuite/gfortran.dg/pr96436_8.f90
 create mode 100644 gcc/testsuite/gfortran.dg/pr96436_9.f90

diff --git a/gcc/testsuite/gfortran.dg/pr96436_1.f90 b/gcc/testsuite/gfortran.dg/pr96436_1.f90
new file mode 100644
index 00000000000..7cc6a0a69b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96436_1.f90
@@ -0,0 +1,10 @@ 
+! { dg-do run }
+! { dg-options "-std=f95 -pedantic" }
+
+character(20) :: fmt
+character(9) :: buffer
+fmt = "(1a1,f0.2,1a1)"
+write(buffer,fmt) ">", 3.0, "<"
+if (buffer.ne.">3.00<") stop 1
+end
+
diff --git a/gcc/testsuite/gfortran.dg/pr96436_10.f90 b/gcc/testsuite/gfortran.dg/pr96436_10.f90
new file mode 100644
index 00000000000..3bd30a9f16b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96436_10.f90
@@ -0,0 +1,10 @@ 
+! { dg-do run }
+! { dg-options "-std=f2008 -pedantic" }
+! { dg-shouldfail "Zero width in format descriptor" }
+
+character(10) :: fmt = "(es0.2)"
+print fmt, 3.
+end
+
+! { dg-output "Fortran runtime error: Zero width in format descriptor" }
+
diff --git a/gcc/testsuite/gfortran.dg/pr96436_2.f90 b/gcc/testsuite/gfortran.dg/pr96436_2.f90
new file mode 100644
index 00000000000..d2d6caffbfe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96436_2.f90
@@ -0,0 +1,10 @@ 
+! { dg-do run }
+! { dg-options "-std=f2003 -pedantic" }
+
+character(20) :: fmt
+character(9) :: buffer
+fmt = "(1a1,f0.2,1a1)"
+write(buffer,fmt) ">", 3.0, "<"
+if (buffer.ne.">3.00<") stop 1
+end
+
diff --git a/gcc/testsuite/gfortran.dg/pr96436_3.f90 b/gcc/testsuite/gfortran.dg/pr96436_3.f90
new file mode 100644
index 00000000000..2750231312f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96436_3.f90
@@ -0,0 +1,13 @@ 
+! { dg-do run }
+! { dg-options "-std=f2008 -pedantic" }
+
+character(20) :: fmt
+character(9) :: buffer
+fmt = "(1a1,f0.2,1a1)"
+write(buffer,fmt) ">", 3.0, "<"
+if (buffer.ne.">3.00<") stop 1
+fmt = "(1a1,g0.2,1a1)"
+write(buffer,fmt) ">", 0.3, "<"
+if (buffer.ne.">0.30<") stop 2
+end
+
diff --git a/gcc/testsuite/gfortran.dg/pr96436_4.f90 b/gcc/testsuite/gfortran.dg/pr96436_4.f90
new file mode 100644
index 00000000000..335ce5fb009
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96436_4.f90
@@ -0,0 +1,25 @@ 
+! { dg-do run }
+! { dg-options "-std=f2018 -pedantic" }
+
+character(20) :: fmt
+character(9) :: buffer
+fmt = "(1a1,f0.2,1a1)"
+write(buffer,fmt) ">", 3.0, "<"
+if (buffer.ne.">3.00<") stop 1
+fmt = "(1a1,g0.2,1a1)"
+write(buffer,fmt) ">", 0.3, "<"
+if (buffer.ne.">0.30<") stop 2
+fmt = "(1a1,d0.2,1a1)"
+write(buffer,fmt) ">", 3.0, "<"
+if (buffer.ne.">0.30D+1<") stop 3
+fmt = "(1a1,e0.2,1a1)"
+write(buffer,fmt) ">", 3.0, "<"
+if (buffer.ne.">0.30E+1<") stop 4
+fmt = "(1a1,en0.2,1a1)"
+write(buffer,fmt) ">", 3.0, "<"
+if (buffer.ne.">3.00<") stop 5
+fmt = "(1a1,es0.2,1a1)"
+write(buffer,fmt) ">", 3.0, "<"
+if (buffer.ne.">3.00<") stop 6
+end
+
diff --git a/gcc/testsuite/gfortran.dg/pr96436_5.f90 b/gcc/testsuite/gfortran.dg/pr96436_5.f90
new file mode 100644
index 00000000000..a45df8963c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96436_5.f90
@@ -0,0 +1,25 @@ 
+! { dg-do run }
+! { dg-options "-pedantic" }
+
+character(20) :: fmt
+character(9) :: buffer
+fmt = "(1a1,f0.2,1a1)"
+write(buffer,fmt) ">", 3.0, "<"
+if (buffer.ne.">3.00<") stop 1
+fmt = "(1a1,g0.2,1a1)"
+write(buffer,fmt) ">", 0.30, "<"
+if (buffer.ne.">0.30<") stop 2
+fmt = "(1a1,d0.2,1a1)"
+write(buffer,fmt) ">", 3.0, "<"
+if (buffer.ne.">0.30D+1<") stop 3
+fmt = "(1a1,e0.2,1a1)"
+write(buffer,fmt) ">", 3.0, "<"
+if (buffer.ne.">0.30E+1<") stop 4
+fmt = "(1a1,en0.2,1a1)"
+write(buffer,fmt) ">", 3.0, "<"
+if (buffer.ne.">3.00<") stop 5
+fmt = "(1a1,es0.2,1a1)"
+write(buffer,fmt) ">", 3.0, "<"
+if (buffer.ne.">3.00<") stop 6
+end
+
diff --git a/gcc/testsuite/gfortran.dg/pr96436_6.f90 b/gcc/testsuite/gfortran.dg/pr96436_6.f90
new file mode 100644
index 00000000000..e413ffcbd0d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96436_6.f90
@@ -0,0 +1,10 @@ 
+! { dg-do run }
+! { dg-options "-std=f2003 -pedantic" }
+! { dg-shouldfail "Zero width in format descriptor" }
+
+character(10) :: fmt = "(g0.2)"
+print fmt, 0.3
+end
+
+! { dg-output "Fortran runtime error: Zero width in format descriptor" }
+
diff --git a/gcc/testsuite/gfortran.dg/pr96436_7.f90 b/gcc/testsuite/gfortran.dg/pr96436_7.f90
new file mode 100644
index 00000000000..607a7f66c14
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96436_7.f90
@@ -0,0 +1,10 @@ 
+! { dg-do run }
+! { dg-options "-std=f2008 -pedantic" }
+! { dg-shouldfail "Zero width in format descriptor" }
+
+character(10) :: fmt = "(d0.2)"
+print fmt, 3.
+end
+
+! { dg-output "Fortran runtime error: Zero width in format descriptor" }
+
diff --git a/gcc/testsuite/gfortran.dg/pr96436_8.f90 b/gcc/testsuite/gfortran.dg/pr96436_8.f90
new file mode 100644
index 00000000000..b851a75ea4f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96436_8.f90
@@ -0,0 +1,10 @@ 
+! { dg-do run }
+! { dg-options "-std=f2008 -pedantic" }
+! { dg-shouldfail "Zero width in format descriptor" }
+
+character(10) :: fmt = "(e0.2)"
+print fmt, 3.
+end
+
+! { dg-output "Fortran runtime error: Zero width in format descriptor" }
+
diff --git a/gcc/testsuite/gfortran.dg/pr96436_9.f90 b/gcc/testsuite/gfortran.dg/pr96436_9.f90
new file mode 100644
index 00000000000..a10f818f9d2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96436_9.f90
@@ -0,0 +1,10 @@ 
+! { dg-do run }
+! { dg-options "-std=f2008 -pedantic" }
+! { dg-shouldfail "Zero width in format descriptor" }
+
+character(10) :: fmt = "(en0.2)"
+print fmt, 3.
+end
+
+! { dg-output "Fortran runtime error: Zero width in format descriptor" }
+
diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index 3be861fb19c..0959b3d8f84 100644
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -617,6 +617,7 @@  parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
   int repeat;
   format_data *fmt = dtp->u.p.fmt;
   bool seen_data_desc = false;
+  int standard;
 
   head = tail = NULL;
 
@@ -929,7 +930,14 @@  parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
       /* Processing for zero width formats.  */
       if (u == FMT_ZERO)
 	{
-	  if (notification_std (GFC_STD_F2008) == NOTIFICATION_ERROR
+          if (t == FMT_F)
+	    standard = GFC_STD_F95;
+	  else if (t == FMT_G)
+	    standard = GFC_STD_F2008;
+	  else
+	    standard = GFC_STD_F2018;
+
+	  if (notification_std (standard) == NOTIFICATION_ERROR
 	      || dtp->u.p.mode == READING)
 	    {
 	      fmt->error = zero_width;
-- 
2.11.0