2 !{ dg-options "-std=legacy" }
4 ! Tests various combinations of intrinsic types, derived types, arrays,
5 ! dummy arguments and common to check nml_get_addr_expr in trans-io.c.
6 ! See comments below for selection.
7 ! provided by Paul Thomas - pault@gcc.gnu.org
19 integer :: i(2) = (/101,201/)
22 real(kind=8) :: pi = 3.14159_8
23 character*10 :: chs="singleton"
24 character*10 :: cha(2)=(/"first ","second "/)
26 dt = mt ((/99,999,9999,99999/))
27 cdt = mt ((/-99,-999,-9999,-99999/))
28 call foo (i,dt,pi,chs,cha)
32 logical function dttest (dt1, dt2)
36 dttest = any(dt1%ii == dt2%ii)
40 subroutine foo (i, dt, pi, chs, cha)
43 real(kind=8) :: pi !local real scalar
44 integer :: i(2) !dummy arg. array
45 integer :: j(2) = (/21, 21/) !equivalenced array
46 integer :: jj ! -||- scalar
48 type(mt) :: dt(2) !dummy arg., derived array
49 type(mt) :: dtl(2) !in-scope derived type array
50 type(mt) :: dts !in-scope derived type
51 type(mt) :: cdt !derived type in common block
52 character*10 :: chs !dummy arg. character var.
53 character*10 :: cha(:) !dummy arg. character array
54 character*10 :: chl="abcdefg" !in-scope character var.
56 namelist /z/ dt, dtl, dts, cdt, j, jj, i, pi, chs, chl, cha
58 dts = mt ((/1, 2, 3, 4/))
59 dtl = mt ((/41, 42, 43, 44/))
61 open (10, status = "scratch", delim='apostrophe')
62 write (10, nml = z, iostat = ier)
63 if (ier /= 0 ) call abort()
70 dt = mt ((/0, 0, 0, 0/))
71 dtl = mt ((/0, 0, 0, 0/))
72 dts = mt ((/0, 0, 0, 0/))
73 cdt = mt ((/0, 0, 0, 0/))
78 read (10, nml = z, iostat = ier)
79 if (ier /= 0 ) call abort()
82 if (.not.(dttest (dt(1), mt ((/99,999,9999,99999/))) .and. &
83 dttest (dt(2), mt ((/99,999,9999,99999/))) .and. &
84 dttest (dtl(1), mt ((/41, 42, 43, 44/))) .and. &
85 dttest (dtl(2), mt ((/41, 42, 43, 44/))) .and. &
86 dttest (dts, mt ((/1, 2, 3, 4/))) .and. &
87 dttest (cdt, mt ((/-99,-999,-9999,-99999/))) .and. &
88 all (j ==(/21, 21/)) .and. &
89 all (i ==(/101, 201/)) .and. &
90 (pi == 3.14159_8) .and. &
91 (chs == "singleton") .and. &
92 (chl == "abcdefg") .and. &
93 (cha(1)(1:10) == "first ") .and. &
94 (cha(2)(1:10) == "second "))) call abort ()
97 end program namelist_14
99 ! { dg-final { cleanup-modules "global" } }