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