1! { dg-do run } 2! PR78670 Incorrect file position with namelist read under DTIO 3MODULE m 4 IMPLICIT NONE 5 TYPE :: t 6 CHARACTER :: c 7 CONTAINS 8 PROCEDURE :: read_formatted 9 GENERIC :: READ(FORMATTED) => read_formatted 10 PROCEDURE :: write_formatted 11 GENERIC :: WRITE(FORMATTED) => write_formatted 12 END TYPE t 13CONTAINS 14 SUBROUTINE write_formatted(dtv, unit, iotype, v_list, iostat, iomsg) 15 CLASS(t), INTENT(IN) :: dtv 16 INTEGER, INTENT(IN) :: unit 17 CHARACTER(*), INTENT(IN) :: iotype 18 INTEGER, INTENT(IN) :: v_list(:) 19 INTEGER, INTENT(OUT) :: iostat 20 CHARACTER(*), INTENT(INOUT) :: iomsg 21 write(unit,'(a)', iostat=iostat, iomsg=iomsg) dtv%c 22 END SUBROUTINE write_formatted 23 24 SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg) 25 CLASS(t), INTENT(INOUT) :: dtv 26 INTEGER, INTENT(IN) :: unit 27 CHARACTER(*), INTENT(IN) :: iotype 28 INTEGER, INTENT(IN) :: v_list(:) 29 INTEGER, INTENT(OUT) :: iostat 30 CHARACTER(*), INTENT(INOUT) :: iomsg 31 32 CHARACTER :: ch 33 dtv%c = '' 34 DO 35 READ (unit, "(A)", IOSTAT=iostat, IOMSG=iomsg) ch 36 IF (iostat /= 0) RETURN 37 ! Store first non-blank 38 IF (ch /= ' ') THEN 39 dtv%c = ch 40 RETURN 41 END IF 42 END DO 43 END SUBROUTINE read_formatted 44END MODULE m 45 46PROGRAM p 47 USE m 48 IMPLICIT NONE 49 TYPE(t) :: x 50 TYPE(t) :: y 51 TYPE(t) :: z 52 integer :: j, k 53 NAMELIST /nml/ j, x, y, z, k 54 INTEGER :: unit, iostatus 55 56 OPEN(NEWUNIT=unit, STATUS='SCRATCH', ACTION='READWRITE') 57 58 x%c = 'a' 59 y%c = 'b' 60 z%c = 'c' 61 j=1 62 k=2 63 WRITE(unit, nml) 64 REWIND (unit) 65 x%c = 'x' 66 y%c = 'y' 67 z%c = 'x' 68 j=99 69 k=99 70 READ (unit, nml, iostat=iostatus) 71 if (iostatus.ne.0) STOP 1 72 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 73 !WRITE(*, nml) 74END PROGRAM p 75