1! { dg-do run } 2! PR78854 namelist write to internal unit. 3module m 4 implicit none 5 type :: t 6 character :: c 7 integer :: k 8 contains 9 procedure :: write_formatted 10 generic :: write(formatted) => write_formatted 11 procedure :: read_formatted 12 generic :: read(formatted) => read_formatted 13 end type 14contains 15 subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg) 16 class(t), intent(in) :: dtv 17 integer, intent(in) :: unit 18 character(*), intent(in) :: iotype 19 integer, intent(in) :: v_list(:) 20 integer, intent(out) :: iostat 21 character(*), intent(inout) :: iomsg 22 if (iotype.eq."NAMELIST") then 23 write (unit, '(a1,a1,i3)') dtv%c,',', dtv%k 24 else 25 write (unit,*) dtv%c, dtv%k 26 end if 27 end subroutine 28 subroutine read_formatted(dtv, unit, iotype, v_list, iostat, iomsg) 29 class(t), intent(inout) :: dtv 30 integer, intent(in) :: unit 31 character(*), intent(in) :: iotype 32 integer, intent(in) :: v_list(:) 33 integer, intent(out) :: iostat 34 character(*), intent(inout) :: iomsg 35 character :: comma 36 if (iotype.eq."NAMELIST") then 37 read (unit, '(a1,a1,i3)') dtv%c, comma, dtv%k 38 else 39 read (unit,*) dtv%c, comma, dtv%k 40 end if 41 if (comma /= ',') STOP 1 42 end subroutine 43end module 44 45program p 46 use m 47 implicit none 48 character(len=50) :: buffer 49 type(t) :: x 50 namelist /nml/ x 51 x = t('a', 5) 52 write (buffer, nml) 53 if (buffer.ne.'&NML X=a, 5 /') STOP 1 54 x = t('x', 0) 55 read (buffer, nml) 56 if (x%c.ne.'a'.or. x%k.ne.5) STOP 2 57end 58