From c2a0fd7c8ff426cc40ec678efef85e4a376ea4b5 Mon Sep 17 00:00:00 2001 From: Mark Eggleston 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-20 Mark Eggleston libgfortran/ PR fortran/96436 * io/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-20 Mark Eggleston gcc/testsuite/ PR fortran/96436 * gfortran.dg/pr96436_1.f90: New test. * gfortran.dg/pr96436_2.f90: New test. * gfortran.dg/pr96436_3.f90: New test. * gfortran.dg/pr96436_4.f90: New test. * gfortran.dg/pr96436_5.f90: New test. * gfortran.dg/pr96436_6.f90: New test. * gfortran.dg/pr96436_7.f90: New test. * gfortran.dg/pr96436_8.f90: New test. * 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.30.2