1! RUN: %S/test_errors.sh %s %t %f18
2  character(kind=1,len=50) internal_file
3  character(kind=1,len=100) msg
4  character(20) sign
5  integer*1 stat1, id1
6  integer*2 stat2
7  integer*4 stat4
8  integer*8 stat8
9  integer :: iunit = 10
10  integer, parameter :: junit = 11
11  integer, pointer :: a(:)
12
13  namelist /nnn/ nn1, nn2
14
15  sign = 'suppress'
16
17  open(10)
18
19  write(*)
20  write(*, *)
21  write(*)
22  write(*, *)
23  write(unit=*) 'Ok'
24  write(unit=iunit)
25  write(unit=junit)
26  write(unit=iunit, *)
27  write(unit=junit, *)
28  write(10)
29  write(unit=10) 'Ok'
30  write(*, nnn)
31  write(10, nnn)
32  write(internal_file)
33  write(internal_file, *)
34  write(internal_file, fmt=*)
35  write(internal_file, fmt=1) 'Ok'
36  write(internal_file, nnn)
37  write(internal_file, nml=nnn)
38  write(unit=internal_file, *)
39  write(fmt=*, unit=internal_file)
40  write(10, advance='yes', fmt=1) 'Ok'
41  write(10, *, delim='quote', sign='plus') jj
42  write(10, '(A)', advance='no', asynchronous='yes', decimal='comma', &
43      err=9, id=id, iomsg=msg, iostat=stat2, round='processor_defined', &
44      sign=sign) 'Ok'
45
46  print*
47  print*, 'Ok'
48
49  allocate(a(2), stat=stat2)
50  allocate(a(8), stat=stat8)
51
52  !ERROR: Duplicate UNIT specifier
53  write(internal_file, unit=*)
54
55  !ERROR: WRITE statement must have a UNIT specifier
56  write(nml=nnn)
57
58  !ERROR: WRITE statement must not have a BLANK specifier
59  !ERROR: WRITE statement must not have a END specifier
60  !ERROR: WRITE statement must not have a EOR specifier
61  !ERROR: WRITE statement must not have a PAD specifier
62  write(*, eor=9, blank='zero', end=9, pad='no')
63
64  !ERROR: If NML appears, REC must not appear
65  !ERROR: If NML appears, FMT must not appear
66  !ERROR: If NML appears, a data list must not appear
67  write(10, nnn, rec=40, fmt=1) 'Ok'
68
69  !ERROR: If UNIT=* appears, POS must not appear
70  write(*, pos=n, nml=nnn)
71
72  !ERROR: If UNIT=* appears, REC must not appear
73  write(*, rec=n)
74
75  !ERROR: If UNIT=internal-file appears, POS must not appear
76  write(internal_file, err=9, pos=n, nml=nnn)
77
78  !ERROR: If UNIT=internal-file appears, REC must not appear
79  write(internal_file, rec=n, err=9)
80
81  !ERROR: If UNIT=* appears, REC must not appear
82  write(*, rec=13) 'Ok'
83
84  !ERROR: If ADVANCE appears, UNIT=internal-file must not appear
85  write(internal_file, advance='yes', fmt=1) 'Ok'
86
87  !ERROR: If ADVANCE appears, an explicit format must also appear
88  write(10, advance='yes') 'Ok'
89
90  !ERROR: Invalid ASYNCHRONOUS value 'non'
91  write(*, asynchronous='non')
92
93  !ERROR: If ASYNCHRONOUS='YES' appears, UNIT=number must also appear
94  write(*, asynchronous='yes')
95
96  !ERROR: If ASYNCHRONOUS='YES' appears, UNIT=number must also appear
97  write(internal_file, asynchronous='yes')
98
99  !ERROR: If ID appears, ASYNCHRONOUS='YES' must also appear
100  write(10, *, id=id) "Ok"
101
102  !ERROR: If ID appears, ASYNCHRONOUS='YES' must also appear
103  write(10, *, id=id, asynchronous='no') "Ok"
104
105  !ERROR: If POS appears, REC must not appear
106  write(10, pos=13, rec=13) 'Ok'
107
108  !ERROR: If DECIMAL appears, FMT or NML must also appear
109  !ERROR: If ROUND appears, FMT or NML must also appear
110  !ERROR: If SIGN appears, FMT or NML must also appear
111  !ERROR: Invalid DECIMAL value 'Komma'
112  write(10, decimal='Komma', sign='plus', round='down') jj
113
114  !ERROR: If DELIM appears, FMT=* or NML must also appear
115  !ERROR: Invalid DELIM value 'Nix'
116  write(delim='Nix', fmt='(A)', unit=10) 'Ok'
117
118  !ERROR: ID kind (1) is smaller than default INTEGER kind (4)
119  write(id=id1, unit=10, asynchronous='Yes') 'Ok'
120
121  write(*, '(X)')
122
1231 format (A)
1249 continue
125end
126