1!{ dg-do run } 2!{ dg-options "-std=legacy" } 3! 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 8 9module global 10 type :: mt 11 sequence 12 integer :: ii(4) 13 end type mt 14end module global 15 16program namelist_14 17 use global 18 common /myc/ cdt 19 integer :: i(2) = (/101,201/) 20 type(mt) :: dt(2) 21 type(mt) :: cdt 22 real(kind=8) :: pi = 3.14159_8 23 character*10 :: chs="singleton" 24 character*10 :: cha(2)=(/"first ","second "/) 25 26 dt = mt ((/99,999,9999,99999/)) 27 cdt = mt ((/-99,-999,-9999,-99999/)) 28 call foo (i,dt,pi,chs,cha) 29 30contains 31 32 logical function dttest (dt1, dt2) 33 use global 34 type(mt) :: dt1 35 type(mt) :: dt2 36 dttest = any(dt1%ii == dt2%ii) 37 end function dttest 38 39 40 subroutine foo (i, dt, pi, chs, cha) 41 use global 42 common /myc/ cdt 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 47 integer :: ier 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. 55 equivalence (j,jj) 56 namelist /z/ dt, dtl, dts, cdt, j, jj, i, pi, chs, chl, cha 57 58 dts = mt ((/1, 2, 3, 4/)) 59 dtl = mt ((/41, 42, 43, 44/)) 60 61 open (10, status = "scratch", delim='apostrophe') 62 write (10, nml = z, iostat = ier) 63 if (ier /= 0 ) call abort() 64 rewind (10) 65 66 i = 0 67 j = 0 68 jj = 0 69 pi = 0 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/)) 74 chs = "" 75 cha = "" 76 chl = "" 77 78 read (10, nml = z, iostat = ier) 79 if (ier /= 0 ) call abort() 80 close (10) 81 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 () 95 96 end subroutine foo 97end program namelist_14 98