Commit 73a958c6 by Jerry DeLisle

re PR fortran/87318 (gfortran.dg/dtio_1.f90 is invalid)

2018-09-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/87318
	* gfortran.dg/dtio_1.f90: Update test to valid code.

From-SVN: r264505
parent 091a8640
2018-09-22 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/87318
* gfortran.dg/dtio_1.f90: Update test to valid code.
2018-09-22 Paul Thomas <pault@gcc.gnu.org> 2018-09-22 Paul Thomas <pault@gcc.gnu.org>
PR fortran/85603 PR fortran/85603
......
...@@ -7,8 +7,8 @@ ...@@ -7,8 +7,8 @@
! to control execution. ! to control execution.
! 3) Tests parsing of the optional vlist, passing in and using it to ! 3) Tests parsing of the optional vlist, passing in and using it to
! generate a user defined format string. ! generate a user defined format string.
! 4) Tests passing an iostat or iomsg out of libgfortranthe child procedure back to ! 4) Tests passing an iostat or iomsg out of the libgfortran child
! the parent. ! procedure back to the parent.
! !
MODULE p MODULE p
USE ISO_FORTRAN_ENV USE ISO_FORTRAN_ENV
...@@ -33,7 +33,6 @@ CONTAINS ...@@ -33,7 +33,6 @@ CONTAINS
INTEGER :: myios INTEGER :: myios
udfmt='(*(g0))' udfmt='(*(g0))'
iomsg = "SUCCESS"
iostat=0 iostat=0
if (iotype.eq."DT") then if (iotype.eq."DT") then
if (size(vlist).ne.0) print *, 36 if (size(vlist).ne.0) print *, 36
...@@ -64,6 +63,7 @@ CONTAINS ...@@ -64,6 +63,7 @@ CONTAINS
if (iotype.eq."NAMELIST") then if (iotype.eq."NAMELIST") then
if (size(vlist).ne.0) print *, 59 if (size(vlist).ne.0) print *, 59
iostat=6000 iostat=6000
iomsg = "NAMELIST not implemented in pwf"
endif endif
END SUBROUTINE pwf END SUBROUTINE pwf
...@@ -78,7 +78,6 @@ CONTAINS ...@@ -78,7 +78,6 @@ CONTAINS
INTEGER :: myios INTEGER :: myios
real :: areal real :: areal
udfmt='(*(g0))' udfmt='(*(g0))'
iomsg = "SUCCESS"
iostat=0 iostat=0
if (iotype.eq."DT") then if (iotype.eq."DT") then
if (size(vlist).ne.0) print *, 36 if (size(vlist).ne.0) print *, 36
...@@ -109,8 +108,8 @@ CONTAINS ...@@ -109,8 +108,8 @@ CONTAINS
if (iotype.eq."NAMELIST") then if (iotype.eq."NAMELIST") then
if (size(vlist).ne.0) print *, 59 if (size(vlist).ne.0) print *, 59
iostat=6000 iostat=6000
iomsg = "NAMELIST not implemented in prf"
endif endif
!READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age
END SUBROUTINE prf END SUBROUTINE prf
END MODULE p END MODULE p
...@@ -126,12 +125,12 @@ PROGRAM test ...@@ -126,12 +125,12 @@ PROGRAM test
chairman%age=62 chairman%age=62
member%name="George" member%name="George"
member%age=42 member%age=42
astring = "FAILURE" astring = "SUCCESS"
write (10, "(DT'zeroth',3x, DT'three'(11,4,10),11x,DT'two'(8,2))", & write (10, "(DT'zeroth',3x, DT'three'(11,4,10),11x,DT'two'(8,2))", &
& iostat=myiostat, iomsg=astring) member, chairman, member & iostat=myiostat, iomsg=astring) member, chairman, member
if (myiostat.ne.0) STOP 3 if (myiostat.ne.0) STOP 3
if (astring.ne."SUCCESS") STOP 4 if (astring.ne."SUCCESS") STOP 4
astring = "FAILURE" astring = "SUCCESS"
write (10, *, iostat=myiostat, iomsg=astring) member, chairman, member write (10, *, iostat=myiostat, iomsg=astring) member, chairman, member
if (myiostat.ne.0) STOP 5 if (myiostat.ne.0) STOP 5
if (astring.ne."SUCCESS") STOP 6 if (astring.ne."SUCCESS") STOP 6
...@@ -141,7 +140,7 @@ PROGRAM test ...@@ -141,7 +140,7 @@ PROGRAM test
chairman%age=99 chairman%age=99
member%name="bogus2" member%name="bogus2"
member%age=66 member%age=66
astring = "FAILURE" astring = "SUCCESS"
read(10,"(DT'zeroth',3x, DT'three'(11,4,10),11x,DT'two'(8,2))") member, chairman, member read(10,"(DT'zeroth',3x, DT'three'(11,4,10),11x,DT'two'(8,2))") member, chairman, member
if (member%name.ne."George") STOP 7 if (member%name.ne."George") STOP 7
if (chairman%name.ne." Charlie") STOP 8 if (chairman%name.ne." Charlie") STOP 8
...@@ -151,12 +150,12 @@ PROGRAM test ...@@ -151,12 +150,12 @@ PROGRAM test
chairman%age=99 chairman%age=99
member%name="bogus2" member%name="bogus2"
member%age=66 member%age=66
astring = "FAILURE" astring = "SAME"
read (10, *, iostat=myiostat, iomsg=astring) member, chairman, member read (10, *, iostat=myiostat, iomsg=astring) member, chairman, member
! The user defined procedure reads to the end of the line/file, then finalizing the parent ! The user defined procedure reads to the end of the line/file, then finalizing the parent
! reads past, so we wrote a blank line above. User needs to address these nuances in their ! reads past, so we wrote a blank line above. User needs to address these nuances in their
! procedures. (subject to interpretation) ! procedures. (subject to interpretation)
if (astring.ne."SUCCESS") STOP 11 if (astring.ne."SAME" .or. myiostat.ne.0) STOP 11
if (member%name.ne."George") STOP 12 if (member%name.ne."George") STOP 12
if (chairman%name.ne."Charlie") STOP 13 if (chairman%name.ne."Charlie") STOP 13
if (member%age.ne.42) STOP 14 if (member%age.ne.42) STOP 14
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment