2 ! PR80333 Namelist dtio write of array of class does not traverse the array
3 ! This test checks both NAMELIST WRITE and READ of an array of class
10 procedure :: read_formatted
11 generic :: read(formatted) => read_formatted
12 procedure :: write_formatted
13 generic :: write(formatted) => write_formatted
16 subroutine read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
17 class(t), intent(inout) :: dtv
18 integer, intent(in) :: unit
19 character(*), intent(in) :: iotype
20 integer, intent(in) :: v_list(:)
21 integer, intent(out) :: iostat
22 character(*), intent(inout) :: iomsg
24 read(unit,'(a1,a1)', iostat=iostat, iomsg=iomsg) dtv%c, dtv%d
25 end subroutine read_formatted
27 subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
28 class(t), intent(in) :: 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 write(unit,'(a1,a1)', iostat=iostat, iomsg=iomsg) dtv%c, dtv%d
35 end subroutine write_formatted
41 class(t), dimension(:,:), allocatable :: w
43 integer :: unit, iostatus
44 character(256) :: str = ""
46 open(10, status='scratch')
55 if (str.ne." jr jr jr jr jr jr jr jr jr jr jr jr jr jr kr kr kr jr jr jr jr jr jr jr jr jr jr jr jr jr") &
58 write(str,"(*(DT))") w
59 if (str.ne."jrjrjrjrjrjrjrjrjrjrjrjrjrjrkrkrkrjrjrjrjrjrjrjrjrjrjrjrjrjr") STOP 2