git://gcc.gnu.org / gcc.git / blame
| Commit | Line | Data |
|---|---|---|
| 29dc5138 PT |
1 | !{ dg-do run } |
| 2 | ! Tests various combinations of intrinsic types, derived types, arrays, | |
| 3 | ! dummy arguments and common to check nml_get_addr_expr in trans-io.c. | |
| 4 | ! See comments below for selection. | |
| 5 | ! provided by Paul Thomas - pault@gcc.gnu.org | |
| 6 | ||
| 7 | module global | |
| 8 | type :: mt | |
| 9 | integer :: ii(4) | |
| 10 | end type mt | |
| 11 | end module global | |
| 12 | ||
| 13 | program namelist_14 | |
| 14 | use global | |
| 15 | common /myc/ cdt | |
| 16 | integer :: i(2) = (/101,201/) | |
| 17 | type(mt) :: dt(2) | |
| 18 | type(mt) :: cdt | |
| df8652dc | 19 | real(kind=8) :: pi = 3.14159_8 |
| 29dc5138 PT |
20 | character*10 :: chs="singleton" |
| 21 | character*10 :: cha(2)=(/"first ","second "/) | |
| 22 | ||
| 23 | dt = mt ((/99,999,9999,99999/)) | |
| 24 | cdt = mt ((/-99,-999,-9999,-99999/)) | |
| 25 | call foo (i,dt,pi,chs,cha) | |
| 26 | ||
| 27 | contains | |
| 28 | ||
| 29 | logical function dttest (dt1, dt2) | |
| 30 | use global | |
| 31 | type(mt) :: dt1 | |
| 32 | type(mt) :: dt2 | |
| 33 | dttest = any(dt1%ii == dt2%ii) | |
| 34 | end function dttest | |
| 35 | ||
| 36 | ||
| 37 | subroutine foo (i, dt, pi, chs, cha) | |
| 38 | use global | |
| 39 | common /myc/ cdt | |
| df8652dc | 40 | real(kind=8) :: pi !local real scalar |
| 29dc5138 PT |
41 | integer :: i(2) !dummy arg. array |
| 42 | integer :: j(2) = (/21, 21/) !equivalenced array | |
| 43 | integer :: jj ! -||- scalar | |
| 44 | integer :: ier | |
| 45 | type(mt) :: dt(2) !dummy arg., derived array | |
| 46 | type(mt) :: dtl(2) !in-scope derived type array | |
| 47 | type(mt) :: dts !in-scope derived type | |
| 48 | type(mt) :: cdt !derived type in common block | |
| 49 | character*10 :: chs !dummy arg. character var. | |
| 50 | character*10 :: cha(:) !dummy arg. character array | |
| 51 | character*10 :: chl="abcdefg" !in-scope character var. | |
| 52 | equivalence (j,jj) | |
| 53 | namelist /z/ dt, dtl, dts, cdt, j, jj, i, pi, chs, chl, cha | |
| 54 | ||
| 55 | dts = mt ((/1, 2, 3, 4/)) | |
| 56 | dtl = mt ((/41, 42, 43, 44/)) | |
| 57 | ||
| 4cc233c4 | 58 | open (10, status = "scratch", delim='apostrophe') |
| 29dc5138 PT |
59 | write (10, nml = z, iostat = ier) |
| 60 | if (ier /= 0 ) call abort() | |
| 61 | rewind (10) | |
| 62 | ||
| 63 | i = 0 | |
| 64 | j = 0 | |
| 65 | jj = 0 | |
| 66 | pi = 0 | |
| 67 | dt = mt ((/0, 0, 0, 0/)) | |
| 68 | dtl = mt ((/0, 0, 0, 0/)) | |
| 69 | dts = mt ((/0, 0, 0, 0/)) | |
| 70 | cdt = mt ((/0, 0, 0, 0/)) | |
| 71 | chs = "" | |
| 72 | cha = "" | |
| 73 | chl = "" | |
| 74 | ||
| 75 | read (10, nml = z, iostat = ier) | |
| 76 | if (ier /= 0 ) call abort() | |
| 77 | close (10) | |
| 78 | ||
| 79 | if (.not.(dttest (dt(1), mt ((/99,999,9999,99999/))) .and. & | |
| 80 | dttest (dt(2), mt ((/99,999,9999,99999/))) .and. & | |
| 81 | dttest (dtl(1), mt ((/41, 42, 43, 44/))) .and. & | |
| 82 | dttest (dtl(2), mt ((/41, 42, 43, 44/))) .and. & | |
| 83 | dttest (dts, mt ((/1, 2, 3, 4/))) .and. & | |
| 84 | dttest (cdt, mt ((/-99,-999,-9999,-99999/))) .and. & | |
| 85 | all (j ==(/21, 21/)) .and. & | |
| 86 | all (i ==(/101, 201/)) .and. & | |
| 87 | (pi == 3.14159_8) .and. & | |
| 88 | (chs == "singleton") .and. & | |
| 89 | (chl == "abcdefg") .and. & | |
| 90 | (cha(1)(1:10) == "first ") .and. & | |
| 91 | (cha(2)(1:10) == "second "))) call abort () | |
| 92 | ||
| 93 | end subroutine foo | |
| 94 | end program namelist_14 |