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