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) call abort ()
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) call abort ()
135  end subroutine test_err
136
137end program namelist_19
138