! { dg-do run } ! PR80333 Namelist dtio write of array of class does not traverse the array ! This test checks both NAMELIST WRITE and READ of an array of class module m implicit none type :: t character :: c character :: d contains procedure :: read_formatted generic :: read(formatted) => read_formatted procedure :: write_formatted generic :: write(formatted) => write_formatted end type t contains subroutine read_formatted(dtv, unit, iotype, v_list, iostat, iomsg) class(t), intent(inout) :: dtv integer, intent(in) :: unit character(*), intent(in) :: iotype integer, intent(in) :: v_list(:) integer, intent(out) :: iostat character(*), intent(inout) :: iomsg integer :: i read(unit,'(a1,a1)', iostat=iostat, iomsg=iomsg) dtv%c, dtv%d end subroutine read_formatted subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg) class(t), intent(in) :: dtv integer, intent(in) :: unit character(*), intent(in) :: iotype integer, intent(in) :: v_list(:) integer, intent(out) :: iostat character(*), intent(inout) :: iomsg write(unit,'(a1,a1)', iostat=iostat, iomsg=iomsg) dtv%c, dtv%d end subroutine write_formatted end module m program p use m implicit none class(t), dimension(:,:), allocatable :: w namelist /nml/ w integer :: unit, iostatus character(256) :: str = "" open(10, status='scratch') allocate(w(10,3)) w = t('j','r') w(5:7,2)%c='k' write(10, nml) rewind(10) w = t('p','z') read(10, nml) write(str,*) w 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") & & STOP 1 str = "" write(str,"(*(DT))") w if (str.ne."jrjrjrjrjrjrjrjrjrjrjrjrjrjrkrkrkrjrjrjrjrjrjrjrjrjrjrjrjrjr") STOP 2 end program p