1! { dg-do run }
2!
3! PR 78661: [OOP] Namelist output missing object designator under DTIO
4!
5! Contributed by Ian Harvey <ian_harvey@bigpond.com>
6
7MODULE m
8  IMPLICIT NONE
9  TYPE :: t
10    CHARACTER :: c
11  CONTAINS
12    PROCEDURE :: write_formatted
13    GENERIC :: WRITE(FORMATTED) => write_formatted
14    PROCEDURE :: read_formatted
15    GENERIC :: READ(FORMATTED) => read_formatted
16  END TYPE
17CONTAINS
18  SUBROUTINE write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
19    CLASS(t), INTENT(IN) :: dtv
20    INTEGER, INTENT(IN) :: unit
21    CHARACTER(*), INTENT(IN) :: iotype
22    INTEGER, INTENT(IN) :: v_list(:)
23    INTEGER, INTENT(OUT) :: iostat
24    CHARACTER(*), INTENT(INOUT) :: iomsg
25    WRITE (unit, "(A)", IOSTAT=iostat, IOMSG=iomsg) dtv%c
26  END SUBROUTINE
27  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
28    CLASS(t), INTENT(INOUT) :: dtv
29    INTEGER, INTENT(IN) :: unit
30    CHARACTER(*), INTENT(IN) :: iotype
31    INTEGER, INTENT(IN) :: v_list(:)
32    INTEGER, INTENT(OUT) :: iostat
33    CHARACTER(*), INTENT(INOUT) :: iomsg
34    READ (unit, "(A)", IOSTAT=iostat, IOMSG=iomsg) dtv%c
35  END SUBROUTINE
36END MODULE
37
38
39PROGRAM p
40
41  USE m
42  IMPLICIT NONE
43  character(len=4), dimension(3) :: buffer
44  call test_type
45  call test_class
46
47contains
48
49  subroutine test_type
50    type(t) :: x
51    namelist /n1/ x
52    x = t('a')
53    write (buffer, n1)
54    if (buffer(2) /= " X=a") STOP 1
55  end subroutine
56
57  subroutine test_class
58    class(t), allocatable :: y
59    namelist /n2/ y
60    y = t('b')
61    write (buffer, n2)
62    if (buffer(2) /= " Y=b") STOP 2
63  end subroutine
64
65END
66