TeamHeptaMirrors/gcc
1
0
Fork 1
mirror of https://github.com/gcc-mirror/gcc.git synced 2026-05-06 14:59:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fortran : rejected f0.d edit descriptor PR96436

Browse Source 
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  <markeggleston@gcc.gnu.org>

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  <markeggleston@gcc.gnu.org>

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
This commit is contained in:
Mark Eggleston
2020-08-04 14:10:08 +01:00
parent 2f5951bd95
commit c2a0fd7c8f
11 changed files with 142 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/testsuite/gfortran.dg/pr96436_1.f90 Normal file
View File

@@ -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

10
gcc/testsuite/gfortran.dg/pr96436_10.f90 Normal file
View File

@@ -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" }

10
gcc/testsuite/gfortran.dg/pr96436_2.f90 Normal file
View File

@@ -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

13
gcc/testsuite/gfortran.dg/pr96436_3.f90 Normal file
View File

@@ -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

25
gcc/testsuite/gfortran.dg/pr96436_4.f90 Normal file
View File

@@ -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

25
gcc/testsuite/gfortran.dg/pr96436_5.f90 Normal file
View File

@@ -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

10
gcc/testsuite/gfortran.dg/pr96436_6.f90 Normal file
View File

@@ -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" }

10
gcc/testsuite/gfortran.dg/pr96436_7.f90 Normal file
View File

@@ -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" }

10
gcc/testsuite/gfortran.dg/pr96436_8.f90 Normal file
View File

@@ -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" }

10
gcc/testsuite/gfortran.dg/pr96436_9.f90 Normal file
View File

@@ -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" }

10
libgfortran/io/format.c
View File

@@ -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;