1!{ dg-do run } 2!{ dg-options "-std=legacy" } 3! 4! Test namelist error trapping. 5! provided by Paul Thomas - pault@gcc.gnu.org 6 7program namelist_19 8 character*80 wrong, right 9 10! "=" before any object name 11 wrong = "&z = i = 1,2 /" 12 right = "&z i = 1,2 /" 13 call test_err(wrong, right) 14 15! &* instead of &end for termination 16 wrong = "&z i = 1,2 &xxx" 17 right = "&z i = 1,2 &end" 18 call test_err(wrong, right) 19 20! bad data 21 wrong = "&z i = 1,q /" 22 right = "&z i = 1,2 /" 23 call test_err(wrong, right) 24 25! object name not matched 26 wrong = "&z j = 1,2 /" 27 right = "&z i = 1,2 /" 28 call test_err(wrong, right) 29 30! derived type component for intrinsic type 31 wrong = "&z i%j = 1,2 /" 32 right = "&z i = 1,2 /" 33 call test_err(wrong, right) 34 35! step other than 1 for substring qualifier 36 wrong = "&z ch(1:2:2) = 'a'/" 37 right = "&z ch(1:2) = 'ab' /" 38 call test_err(wrong, right) 39 40! qualifier for scalar 41 wrong = "&z k(2) = 1 /" 42 right = "&z k = 1 /" 43 call test_err(wrong, right) 44 45! no '=' after object name 46 wrong = "&z i 1,2 /" 47 right = "&z i = 1,2 /" 48 call test_err(wrong, right) 49 50! repeat count too large 51 wrong = "&z i = 3*2 /" 52 right = "&z i = 2*2 /" 53 call test_err(wrong, right) 54 55! too much data 56 wrong = "&z i = 1 2 3 /" 57 right = "&z i = 1 2 /" 58 call test_err(wrong, right) 59 60! no '=' after object name 61 wrong = "&z i 1,2 /" 62 right = "&z i = 1,2 /" 63 call test_err(wrong, right) 64 65! bad number of index fields 66 wrong = "&z i(1,2) = 1 /" 67 right = "&z i(1) = 1 /" 68 call test_err(wrong, right) 69 70! bad character in index field 71 wrong = "&z i(x) = 1 /" 72 right = "&z i(1) = 1 /" 73 call test_err(wrong, right) 74 75! null index field 76 wrong = "&z i( ) = 1 /" 77 right = "&z i(1) = 1 /" 78 call test_err(wrong, right) 79 80! null index field 81 wrong = "&z i(1::) = 1 2/" 82 right = "&z i(1:2:1) = 1 2 /" 83 call test_err(wrong, right) 84 85! null index field 86 wrong = "&z i(1:2:) = 1 2/" 87 right = "&z i(1:2:1) = 1 2 /" 88 call test_err(wrong, right) 89 90! index out of range 91 wrong = "&z i(10) = 1 /" 92 right = "&z i(1) = 1 /" 93 call test_err(wrong, right) 94 95! index out of range 96 wrong = "&z i(0:1) = 1 /" 97 right = "&z i(1:1) = 1 /" 98 call test_err(wrong, right) 99 100! bad range 101 wrong = "&z i(1:2:-1) = 1 2 /" 102 right = "&z i(1:2: 1) = 1 2 /" 103 call test_err(wrong, right) 104 105! bad range 106 wrong = "&z i(2:1: 1) = 1 2 /" 107 right = "&z i(2:1:-1) = 1 2 /" 108 call test_err(wrong, right) 109 110contains 111 subroutine test_err(wrong, right) 112 character*80 wrong, right 113 integer :: i(2) = (/0, 0/) 114 integer :: k =0 115 character*2 :: ch = " " 116 namelist /z/ i, k, ch 117 118! Check that wrong namelist input gives an error 119 120 open (10, status = "scratch") 121 write (10, '(A)') wrong 122 rewind (10) 123 read (10, z, iostat = ier) 124 close(10) 125 if (ier == 0) STOP 1 126 127! Check that right namelist input gives no error 128 129 open (10, status = "scratch") 130 write (10, '(A)') right 131 rewind (10) 132 read (10, z, iostat = ier) 133 close(10) 134 if (ier /= 0) STOP 2 135 end subroutine test_err 136 137end program namelist_19 138