1! { dg-do run }
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
4module m
5  implicit none
6  type :: t
7    character :: c
8    character :: d
9  contains
10    procedure :: read_formatted
11    generic :: read(formatted) => read_formatted
12    procedure :: write_formatted
13    generic :: write(formatted) => write_formatted
14  end type t
15contains
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
23    integer :: i
24    read(unit,'(a1,a1)', iostat=iostat, iomsg=iomsg) dtv%c, dtv%d
25  end subroutine read_formatted
26
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
36end module m
37
38program p
39  use m
40  implicit none
41  class(t), dimension(:,:), allocatable :: w
42  namelist /nml/  w
43  integer :: unit, iostatus
44  character(256) :: str = ""
45
46  open(10, status='scratch')
47  allocate(w(10,3))
48  w = t('j','r')
49  w(5:7,2)%c='k'
50  write(10, nml)
51  rewind(10)
52  w = t('p','z')
53  read(10, nml)
54  write(str,*) w
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") &
56      & STOP 1
57  str = ""
58  write(str,"(*(DT))") w
59  if (str.ne."jrjrjrjrjrjrjrjrjrjrjrjrjrjrkrkrkrjrjrjrjrjrjrjrjrjrjrjrjrjr") STOP 2
60end program p
61