]>
Commit | Line | Data |
---|---|---|
4ee9c684 | 1 | /* Copyright (C) 2002-2003 Free Software Foundation, Inc. |
2 | Contributed by Andy Vaught | |
3 | ||
4 | This file is part of the GNU Fortran 95 runtime library (libgfortran). | |
5 | ||
6 | Libgfortran is free software; you can redistribute it and/or modify | |
7 | it under the terms of the GNU General Public License as published by | |
8 | the Free Software Foundation; either version 2, or (at your option) | |
9 | any later version. | |
10 | ||
11 | Libgfortran is distributed in the hope that it will be useful, | |
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | GNU General Public License for more details. | |
15 | ||
16 | You should have received a copy of the GNU General Public License | |
17 | along with Libgfortran; see the file COPYING. If not, write to | |
18 | the Free Software Foundation, 59 Temple Place - Suite 330, | |
19 | Boston, MA 02111-1307, USA. */ | |
20 | ||
21 | ||
22 | /* Implement the non-IOLENGTH variant of the INQUIRY statement */ | |
23 | ||
24 | #include "config.h" | |
25 | #include "libgfortran.h" | |
26 | #include "io.h" | |
27 | ||
28 | ||
29 | static char undefined[] = "UNDEFINED"; | |
30 | ||
31 | ||
32 | /* inquire_via_unit()-- Inquiry via unit number. The unit might not exist. */ | |
33 | ||
34 | static void | |
35 | inquire_via_unit (unit_t * u) | |
36 | { | |
37 | const char *p; | |
38 | ||
39 | if (ioparm.exist != NULL) | |
40 | *ioparm.exist = (u != NULL); | |
41 | ||
42 | if (ioparm.opened != NULL) | |
43 | *ioparm.opened = (u != NULL); | |
44 | ||
45 | if (ioparm.number != NULL) | |
46 | *ioparm.number = (u != NULL) ? u->unit_number : -1; | |
47 | ||
48 | if (ioparm.named != NULL) | |
49 | *ioparm.named = (u != NULL && u->flags.status != STATUS_SCRATCH); | |
50 | ||
51 | if (ioparm.name != NULL && u != NULL && u->flags.status != STATUS_SCRATCH) | |
52 | fstrcpy (ioparm.name, ioparm.name_len, u->file, u->file_len); | |
53 | ||
54 | if (ioparm.access != NULL) | |
55 | { | |
56 | if (u == NULL) | |
57 | p = undefined; | |
58 | else | |
59 | switch (u->flags.access) | |
60 | { | |
61 | case ACCESS_SEQUENTIAL: | |
62 | p = "SEQUENTIAL"; | |
63 | break; | |
64 | case ACCESS_DIRECT: | |
65 | p = "DIRECT"; | |
66 | break; | |
67 | default: | |
68 | internal_error ("inquire_via_unit(): Bad access"); | |
69 | } | |
70 | ||
71 | cf_strcpy (ioparm.access, ioparm.access_len, p); | |
72 | } | |
73 | ||
74 | if (ioparm.sequential != NULL) | |
75 | { | |
76 | p = (u == NULL) ? inquire_sequential (NULL, 0) : | |
77 | inquire_sequential (u->file, u->file_len); | |
78 | ||
79 | cf_strcpy (ioparm.sequential, ioparm.sequential_len, p); | |
80 | } | |
81 | ||
82 | if (ioparm.direct != NULL) | |
83 | { | |
84 | p = (u == NULL) ? inquire_direct (NULL, 0) : | |
85 | inquire_direct (u->file, u->file_len); | |
86 | ||
87 | cf_strcpy (ioparm.direct, ioparm.direct_len, p); | |
88 | } | |
89 | ||
90 | if (ioparm.form != NULL) | |
91 | { | |
92 | if (u == NULL) | |
93 | p = undefined; | |
94 | else | |
95 | switch (u->flags.form) | |
96 | { | |
97 | case FORM_FORMATTED: | |
98 | p = "FORMATTED"; | |
99 | break; | |
100 | case FORM_UNFORMATTED: | |
101 | p = "UNFORMATTED"; | |
102 | break; | |
103 | default: | |
104 | internal_error ("inquire_via_unit(): Bad form"); | |
105 | } | |
106 | ||
107 | cf_strcpy (ioparm.form, ioparm.form_len, p); | |
108 | } | |
109 | ||
110 | if (ioparm.formatted != NULL) | |
111 | { | |
112 | p = (u == NULL) ? inquire_formatted (NULL, 0) : | |
113 | inquire_formatted (u->file, u->file_len); | |
114 | ||
115 | cf_strcpy (ioparm.formatted, ioparm.formatted_len, p); | |
116 | } | |
117 | ||
118 | if (ioparm.unformatted != NULL) | |
119 | { | |
120 | p = (u == NULL) ? inquire_unformatted (NULL, 0) : | |
121 | inquire_unformatted (u->file, u->file_len); | |
122 | ||
123 | cf_strcpy (ioparm.unformatted, ioparm.unformatted_len, p); | |
124 | } | |
125 | ||
126 | if (ioparm.recl_out != NULL) | |
127 | *ioparm.recl_out = (u != NULL) ? u->recl : 0; | |
128 | ||
129 | if (ioparm.nextrec != NULL) | |
130 | *ioparm.nextrec = (u != NULL) ? u->last_record + 1 : 0; | |
131 | ||
132 | if (ioparm.blank != NULL) | |
133 | { | |
134 | if (u == NULL) | |
135 | p = undefined; | |
136 | else | |
137 | switch (u->flags.blank) | |
138 | { | |
139 | case BLANK_NULL: | |
140 | p = "NULL"; | |
141 | break; | |
142 | case BLANK_ZERO: | |
143 | p = "ZERO"; | |
144 | break; | |
145 | default: | |
146 | internal_error ("inquire_via_unit(): Bad blank"); | |
147 | } | |
148 | ||
149 | cf_strcpy (ioparm.blank, ioparm.blank_len, p); | |
150 | } | |
151 | ||
152 | if (ioparm.position != NULL) | |
153 | { | |
154 | if (u == NULL || u->flags.access == ACCESS_DIRECT) | |
155 | p = undefined; | |
156 | else | |
157 | { | |
158 | p = NULL; /* TODO: Try to decode what the standard says... */ | |
159 | } | |
160 | ||
161 | cf_strcpy (ioparm.blank, ioparm.blank_len, p); | |
162 | } | |
163 | ||
164 | if (ioparm.action != NULL) | |
165 | { | |
166 | if (u == NULL) | |
167 | p = undefined; | |
168 | else | |
169 | switch (u->flags.action) | |
170 | { | |
171 | case ACTION_READ: | |
172 | p = "READ"; | |
173 | break; | |
174 | case ACTION_WRITE: | |
175 | p = "WRITE"; | |
176 | break; | |
177 | case ACTION_READWRITE: | |
178 | p = "READWRITE"; | |
179 | break; | |
180 | default: | |
181 | internal_error ("inquire_via_unit(): Bad action"); | |
182 | } | |
183 | ||
184 | cf_strcpy (ioparm.action, ioparm.action_len, p); | |
185 | } | |
186 | ||
187 | if (ioparm.read != NULL) | |
188 | { | |
189 | p = (u == NULL) ? inquire_read (NULL, 0) : | |
190 | inquire_read (u->file, u->file_len); | |
191 | ||
192 | cf_strcpy (ioparm.read, ioparm.read_len, p); | |
193 | } | |
194 | ||
195 | if (ioparm.write != NULL) | |
196 | { | |
197 | p = (u == NULL) ? inquire_write (NULL, 0) : | |
198 | inquire_write (u->file, u->file_len); | |
199 | ||
200 | cf_strcpy (ioparm.write, ioparm.write_len, p); | |
201 | } | |
202 | ||
203 | if (ioparm.readwrite != NULL) | |
204 | { | |
205 | p = (u == NULL) ? inquire_readwrite (NULL, 0) : | |
206 | inquire_readwrite (u->file, u->file_len); | |
207 | ||
208 | cf_strcpy (ioparm.readwrite, ioparm.readwrite_len, p); | |
209 | } | |
210 | ||
211 | if (ioparm.delim != NULL) | |
212 | { | |
213 | if (u == NULL || u->flags.form != FORM_FORMATTED) | |
214 | p = undefined; | |
215 | else | |
216 | switch (u->flags.delim) | |
217 | { | |
218 | case DELIM_NONE: | |
219 | p = "NONE"; | |
220 | break; | |
221 | case DELIM_QUOTE: | |
222 | p = "QUOTE"; | |
223 | break; | |
224 | case DELIM_APOSTROPHE: | |
225 | p = "APOSTROPHE"; | |
226 | break; | |
227 | default: | |
228 | internal_error ("inquire_via_unit(): Bad delim"); | |
229 | } | |
230 | ||
231 | cf_strcpy (ioparm.access, ioparm.access_len, p); | |
232 | } | |
233 | ||
234 | if (ioparm.pad != NULL) | |
235 | { | |
236 | if (u == NULL || u->flags.form != FORM_FORMATTED) | |
237 | p = undefined; | |
238 | else | |
239 | switch (u->flags.pad) | |
240 | { | |
241 | case PAD_NO: | |
242 | p = "NO"; | |
243 | break; | |
244 | case PAD_YES: | |
245 | p = "YES"; | |
246 | break; | |
247 | default: | |
248 | internal_error ("inquire_via_unit(): Bad pad"); | |
249 | } | |
250 | ||
251 | cf_strcpy (ioparm.pad, ioparm.pad_len, p); | |
252 | } | |
253 | } | |
254 | ||
255 | ||
256 | /* inquire_via_filename()-- Inquiry via filename. This subroutine is | |
257 | * only used if the filename is *not* connected to a unit number. */ | |
258 | ||
259 | static void | |
260 | inquire_via_filename (void) | |
261 | { | |
262 | const char *p; | |
263 | ||
264 | if (ioparm.exist != NULL) | |
265 | *ioparm.exist = file_exists (); | |
266 | ||
267 | if (ioparm.opened != NULL) | |
268 | *ioparm.opened = 0; | |
269 | ||
270 | if (ioparm.number != NULL) | |
271 | *ioparm.number = -1; | |
272 | ||
273 | if (ioparm.named != NULL) | |
274 | *ioparm.named = 1; | |
275 | ||
276 | if (ioparm.name != NULL) | |
277 | fstrcpy (ioparm.name, ioparm.name_len, ioparm.file, ioparm.file_len); | |
278 | ||
279 | if (ioparm.access != NULL) | |
280 | cf_strcpy (ioparm.access, ioparm.access_len, undefined); | |
281 | ||
282 | if (ioparm.sequential != NULL) | |
283 | { | |
284 | p = inquire_sequential (ioparm.file, ioparm.file_len); | |
285 | cf_strcpy (ioparm.sequential, ioparm.sequential_len, p); | |
286 | } | |
287 | ||
288 | if (ioparm.direct != NULL) | |
289 | { | |
290 | p = inquire_direct (ioparm.file, ioparm.file_len); | |
291 | cf_strcpy (ioparm.direct, ioparm.direct_len, p); | |
292 | } | |
293 | ||
294 | if (ioparm.form != NULL) | |
295 | cf_strcpy (ioparm.form, ioparm.form_len, undefined); | |
296 | ||
297 | if (ioparm.formatted != NULL) | |
298 | { | |
299 | p = inquire_formatted (ioparm.file, ioparm.file_len); | |
300 | cf_strcpy (ioparm.formatted, ioparm.formatted_len, p); | |
301 | } | |
302 | ||
303 | if (ioparm.unformatted != NULL) | |
304 | { | |
305 | p = inquire_unformatted (ioparm.file, ioparm.file_len); | |
306 | cf_strcpy (ioparm.unformatted, ioparm.unformatted_len, p); | |
307 | } | |
308 | ||
309 | if (ioparm.recl_out != NULL) | |
310 | *ioparm.recl_out = 0; | |
311 | ||
312 | if (ioparm.nextrec != NULL) | |
313 | *ioparm.nextrec = 0; | |
314 | ||
315 | if (ioparm.blank != NULL) | |
316 | cf_strcpy (ioparm.blank, ioparm.blank_len, undefined); | |
317 | ||
318 | if (ioparm.position != NULL) | |
319 | cf_strcpy (ioparm.position, ioparm.position_len, undefined); | |
320 | ||
321 | if (ioparm.access != NULL) | |
322 | cf_strcpy (ioparm.access, ioparm.access_len, undefined); | |
323 | ||
324 | if (ioparm.read != NULL) | |
325 | { | |
326 | p = inquire_read (ioparm.file, ioparm.file_len); | |
327 | cf_strcpy (ioparm.read, ioparm.read_len, p); | |
328 | } | |
329 | ||
330 | if (ioparm.write != NULL) | |
331 | { | |
332 | p = inquire_write (ioparm.file, ioparm.file_len); | |
333 | cf_strcpy (ioparm.write, ioparm.write_len, p); | |
334 | } | |
335 | ||
336 | if (ioparm.readwrite != NULL) | |
337 | { | |
338 | p = inquire_read (ioparm.file, ioparm.file_len); | |
339 | cf_strcpy (ioparm.readwrite, ioparm.readwrite_len, p); | |
340 | } | |
341 | ||
342 | if (ioparm.delim != NULL) | |
343 | cf_strcpy (ioparm.delim, ioparm.delim_len, undefined); | |
344 | ||
345 | if (ioparm.pad != NULL) | |
346 | cf_strcpy (ioparm.pad, ioparm.pad_len, undefined); | |
347 | ||
348 | } | |
349 | ||
350 | ||
351 | ||
352 | void | |
353 | st_inquire (void) | |
354 | { | |
355 | unit_t *u; | |
356 | ||
357 | library_start (); | |
358 | ||
359 | if (ioparm.file == NULL) | |
360 | inquire_via_unit (find_unit (ioparm.unit)); | |
361 | else | |
362 | { | |
363 | u = find_file (); | |
364 | if (u == NULL) | |
365 | inquire_via_filename (); | |
366 | else | |
367 | inquire_via_unit (u); | |
368 | } | |
369 | ||
370 | library_end (); | |
371 | } |