Mercurial > hg > CbC > CbC_gcc

annotate 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
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ! { dg-do run }
kono
parents:
diff changeset
2 ! PR80333 Namelist dtio write of array of class does not traverse the array
kono
parents:
diff changeset
3 ! This test checks both NAMELIST WRITE and READ of an array of class
kono
parents:
diff changeset
4 module m
kono
parents:
diff changeset
5 implicit none
kono
parents:
diff changeset
6 type :: t
kono
parents:
diff changeset
7 character :: c
kono
parents:
diff changeset
8 character :: d
kono
parents:
diff changeset
9 contains
kono
parents:
diff changeset
10 procedure :: read_formatted
kono
parents:
diff changeset
11 generic :: read(formatted) => read_formatted
kono
parents:
diff changeset
12 procedure :: write_formatted
kono
parents:
diff changeset
13 generic :: write(formatted) => write_formatted
kono
parents:
diff changeset
14 end type t
kono
parents:
diff changeset
15 contains
kono
parents:
diff changeset
16 subroutine read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
kono
parents:
diff changeset
17 class(t), intent(inout) :: dtv
kono
parents:
diff changeset
18 integer, intent(in) :: unit
kono
parents:
diff changeset
19 character(*), intent(in) :: iotype
kono
parents:
diff changeset
20 integer, intent(in) :: v_list(:)
kono
parents:
diff changeset
21 integer, intent(out) :: iostat
kono
parents:
diff changeset
22 character(*), intent(inout) :: iomsg
kono
parents:
diff changeset
23 integer :: i
kono
parents:
diff changeset
24 read(unit,'(a1,a1)', iostat=iostat, iomsg=iomsg) dtv%c, dtv%d
kono
parents:
diff changeset
25 end subroutine read_formatted
kono
parents:
diff changeset
26
kono
parents:
diff changeset
27 subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
kono
parents:
diff changeset
28 class(t), intent(in) :: dtv
kono
parents:
diff changeset
29 integer, intent(in) :: unit
kono
parents:
diff changeset
30 character(*), intent(in) :: iotype
kono
parents:
diff changeset
31 integer, intent(in) :: v_list(:)
kono
parents:
diff changeset
32 integer, intent(out) :: iostat
kono
parents:
diff changeset
33 character(*), intent(inout) :: iomsg
kono
parents:
diff changeset
34 write(unit,'(a1,a1)', iostat=iostat, iomsg=iomsg) dtv%c, dtv%d
kono
parents:
diff changeset
35 end subroutine write_formatted
kono
parents:
diff changeset
36 end module m
kono
parents:
diff changeset
37
kono
parents:
diff changeset
38 program p
kono
parents:
diff changeset
39 use m
kono
parents:
diff changeset
40 implicit none
kono
parents:
diff changeset
41 class(t), dimension(:,:), allocatable :: w
kono
parents:
diff changeset
42 namelist /nml/ w
kono
parents:
diff changeset
43 integer :: unit, iostatus
kono
parents:
diff changeset
44 character(256) :: str = ""
kono
parents:
diff changeset
45
kono
parents:
diff changeset
46 open(10, status='scratch')
kono
parents:
diff changeset
47 allocate(w(10,3))
kono
parents:
diff changeset
48 w = t('j','r')
kono
parents:
diff changeset
49 w(5:7,2)%c='k'
kono
parents:
diff changeset
50 write(10, nml)
kono
parents:
diff changeset
51 rewind(10)
kono
parents:
diff changeset
52 w = t('p','z')
kono
parents:
diff changeset
53 read(10, nml)
kono
parents:
diff changeset
54 write(str,*) w
kono
parents:
diff changeset
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") &
kono
parents:
diff changeset
56 & call abort
kono
parents:
diff changeset
57 str = ""
kono
parents:
diff changeset
58 write(str,"(*(DT))") w
kono
parents:
diff changeset
59 if (str.ne."jrjrjrjrjrjrjrjrjrjrjrjrjrjrkrkrkrjrjrjrjrjrjrjrjrjrjrjrjrjr") call abort
kono
parents:
diff changeset
60 end program p