1!{ dg-do run } 2! Tests arrays of derived types containing derived type arrays whose 3! components are character arrays - exercises object name parser in 4! list_read.c. Checks that namelist output can be reread. 5! provided by Paul Thomas - pault@gcc.gnu.org 6 7module global 8 type :: mt 9 character(len=2) :: ch(2) = (/"aa","bb"/) 10 end type mt 11 type :: bt 12 integer :: i(2) = (/1,2/) 13 type(mt) :: m(2) 14 end type bt 15end module global 16 17program namelist_15 18 use global 19 type(bt) :: x(2) 20 21 namelist /mynml/ x 22 23 open (10, status = "scratch", delim='apostrophe') 24 write (10, '(A)') "&MYNML" 25 write (10, '(A)') " x = 3, 4, 'dd', 'ee', 'ff', 'gg'," 26 write (10, '(A)') " 4, 5, 'hh', 'ii', 'jj', 'kk'," 27 write (10, '(A)') " x(1)%i = , ," 28 write (10, '(A)') " x(2)%i = -3, -4" 29 write (10, '(A)') " x(2)%m(1)%ch(2)(1:1) ='q'," 30 write (10, '(A)') " x(2)%m(2)%ch(1)(1:1) ='w'," 31 write (10, '(A)') " x(1)%m(1)%ch(1:2)(2:2) = 'z','z'," 32 write (10, '(A)') " x(2)%m(1)%ch(1:2)(2:2) = 'z','z'," 33 write (10, '(A)') " x(1)%m(2)%ch(1:2)(2:2) = 'z','z'," 34 write (10, '(A)') " x(2)%m(2)%ch(1:2)(2:2) = 'z','z'," 35 write (10, '(A)') "/" 36 37 rewind (10) 38 read (10, nml = mynml, iostat = ier) 39 if (ier .ne. 0) call abort () 40 close (10) 41 42 open (10, status = "scratch", delim='apostrophe') 43 write (10, nml = mynml) 44 rewind (10) 45 46 read (10, nml = mynml, iostat = ier) 47 if (ier .ne. 0) call abort () 48 close(10) 49 50 if (.not. ((x(1)%i(1) == 3) .and. & 51 (x(1)%i(2) == 4) .and. & 52 (x(1)%m(1)%ch(1) == "dz") .and. & 53 (x(1)%m(1)%ch(2) == "ez") .and. & 54 (x(1)%m(2)%ch(1) == "fz") .and. & 55 (x(1)%m(2)%ch(2) == "gz") .and. & 56 (x(2)%i(1) == -3) .and. & 57 (x(2)%i(2) == -4) .and. & 58 (x(2)%m(1)%ch(1) == "hz") .and. & 59 (x(2)%m(1)%ch(2) == "qz") .and. & 60 (x(2)%m(2)%ch(1) == "wz") .and. & 61 (x(2)%m(2)%ch(2) == "kz"))) call abort () 62 63end program namelist_15 64