Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/gfortran.dg/dtio_30.f03 @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
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
4 module 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
15 contains
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
36 end module m
37
38 program 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 & call abort
57 str = ""
58 write(str,"(*(DT))") w
59 if (str.ne."jrjrjrjrjrjrjrjrjrjrjrjrjrjrkrkrkrjrjrjrjrjrjrjrjrjrjrjrjrjr") call abort
60 end program p