mirror of
https://github.com/autc04/Retro68.git
synced 2024-09-28 18:56:06 +00:00
75 lines
1.8 KiB
Fortran
75 lines
1.8 KiB
Fortran
! { dg-do run }
|
|
! PR78670 Incorrect file position with namelist read under DTIO
|
|
MODULE m
|
|
IMPLICIT NONE
|
|
TYPE :: t
|
|
CHARACTER :: c
|
|
CONTAINS
|
|
PROCEDURE :: read_formatted
|
|
GENERIC :: READ(FORMATTED) => read_formatted
|
|
PROCEDURE :: write_formatted
|
|
GENERIC :: WRITE(FORMATTED) => write_formatted
|
|
END TYPE t
|
|
CONTAINS
|
|
SUBROUTINE write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
|
|
CLASS(t), INTENT(IN) :: dtv
|
|
INTEGER, INTENT(IN) :: unit
|
|
CHARACTER(*), INTENT(IN) :: iotype
|
|
INTEGER, INTENT(IN) :: v_list(:)
|
|
INTEGER, INTENT(OUT) :: iostat
|
|
CHARACTER(*), INTENT(INOUT) :: iomsg
|
|
write(unit,'(a)', iostat=iostat, iomsg=iomsg) dtv%c
|
|
END SUBROUTINE write_formatted
|
|
|
|
SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
|
|
CLASS(t), INTENT(INOUT) :: dtv
|
|
INTEGER, INTENT(IN) :: unit
|
|
CHARACTER(*), INTENT(IN) :: iotype
|
|
INTEGER, INTENT(IN) :: v_list(:)
|
|
INTEGER, INTENT(OUT) :: iostat
|
|
CHARACTER(*), INTENT(INOUT) :: iomsg
|
|
|
|
CHARACTER :: ch
|
|
dtv%c = ''
|
|
DO
|
|
READ (unit, "(A)", IOSTAT=iostat, IOMSG=iomsg) ch
|
|
IF (iostat /= 0) RETURN
|
|
! Store first non-blank
|
|
IF (ch /= ' ') THEN
|
|
dtv%c = ch
|
|
RETURN
|
|
END IF
|
|
END DO
|
|
END SUBROUTINE read_formatted
|
|
END MODULE m
|
|
|
|
PROGRAM p
|
|
USE m
|
|
IMPLICIT NONE
|
|
TYPE(t) :: x
|
|
TYPE(t) :: y
|
|
TYPE(t) :: z
|
|
integer :: j, k
|
|
NAMELIST /nml/ j, x, y, z, k
|
|
INTEGER :: unit, iostatus
|
|
|
|
OPEN(NEWUNIT=unit, STATUS='SCRATCH', ACTION='READWRITE')
|
|
|
|
x%c = 'a'
|
|
y%c = 'b'
|
|
z%c = 'c'
|
|
j=1
|
|
k=2
|
|
WRITE(unit, nml)
|
|
REWIND (unit)
|
|
x%c = 'x'
|
|
y%c = 'y'
|
|
z%c = 'x'
|
|
j=99
|
|
k=99
|
|
READ (unit, nml, iostat=iostatus)
|
|
if (iostatus.ne.0) STOP 1
|
|
if (j.ne.1 .or. k.ne.2 .or. x%c.ne.'a' .or. y%c.ne.'b' .or. z%c.ne.'c') STOP 2
|
|
!WRITE(*, nml)
|
|
END PROGRAM p
|