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