]>
Commit | Line | Data |
---|---|---|
41f2d5e8 | 1 | /* Copyright (C) 2002, 2003, 2005, 2007 Free Software Foundation, Inc. |
4ee9c684 | 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 | ||
b417ea8c | 11 | In addition to the permissions in the GNU General Public License, the |
12 | Free Software Foundation gives you unlimited permission to link the | |
13 | compiled version of this file into combinations with other programs, | |
14 | and to distribute those combinations without any restriction coming | |
15 | from the use of this file. (The General Public License restrictions | |
16 | do apply in other respects; for example, they cover modification of | |
17 | the file, and distribution when not linked into a combine | |
18 | executable.) | |
19 | ||
4ee9c684 | 20 | Libgfortran is distributed in the hope that it will be useful, |
21 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
22 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
23 | GNU General Public License for more details. | |
24 | ||
25 | You should have received a copy of the GNU General Public License | |
26 | along with Libgfortran; see the file COPYING. If not, write to | |
5ac2525b | 27 | the Free Software Foundation, 51 Franklin Street, Fifth Floor, |
28 | Boston, MA 02110-1301, USA. */ | |
4ee9c684 | 29 | |
30 | ||
31 | /* Implement the non-IOLENGTH variant of the INQUIRY statement */ | |
32 | ||
4ee9c684 | 33 | #include "io.h" |
34 | ||
35 | ||
fb35179a | 36 | static const char undefined[] = "UNDEFINED"; |
4ee9c684 | 37 | |
38 | ||
39 | /* inquire_via_unit()-- Inquiry via unit number. The unit might not exist. */ | |
40 | ||
41 | static void | |
60c514ba | 42 | inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u) |
4ee9c684 | 43 | { |
44 | const char *p; | |
60c514ba | 45 | GFC_INTEGER_4 cf = iqp->common.flags; |
8e327405 | 46 | GFC_INTEGER_4 cf2 = iqp->flags2; |
4ee9c684 | 47 | |
60c514ba | 48 | if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) |
6550bb3d | 49 | { |
50 | *iqp->exist = (iqp->common.unit >= 0 | |
51 | && iqp->common.unit <= GFC_INTEGER_4_HUGE); | |
52 | ||
53 | if ((cf & IOPARM_INQUIRE_HAS_FILE) == 0) | |
54 | { | |
55 | if (!(*iqp->exist)) | |
56 | *iqp->common.iostat = LIBERROR_BAD_UNIT; | |
57 | *iqp->exist = *iqp->exist | |
58 | && (*iqp->common.iostat != LIBERROR_BAD_UNIT); | |
59 | } | |
60 | } | |
4ee9c684 | 61 | |
60c514ba | 62 | if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0) |
63 | *iqp->opened = (u != NULL); | |
4ee9c684 | 64 | |
60c514ba | 65 | if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0) |
66 | *iqp->number = (u != NULL) ? u->unit_number : -1; | |
4ee9c684 | 67 | |
60c514ba | 68 | if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0) |
69 | *iqp->named = (u != NULL && u->flags.status != STATUS_SCRATCH); | |
4ee9c684 | 70 | |
60c514ba | 71 | if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0 |
72 | && u != NULL && u->flags.status != STATUS_SCRATCH) | |
73 | fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len); | |
4ee9c684 | 74 | |
60c514ba | 75 | if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0) |
4ee9c684 | 76 | { |
77 | if (u == NULL) | |
78 | p = undefined; | |
79 | else | |
80 | switch (u->flags.access) | |
81 | { | |
82 | case ACCESS_SEQUENTIAL: | |
83 | p = "SEQUENTIAL"; | |
84 | break; | |
85 | case ACCESS_DIRECT: | |
86 | p = "DIRECT"; | |
87 | break; | |
4d8ee55b | 88 | case ACCESS_STREAM: |
89 | p = "STREAM"; | |
90 | break; | |
4ee9c684 | 91 | default: |
60c514ba | 92 | internal_error (&iqp->common, "inquire_via_unit(): Bad access"); |
4ee9c684 | 93 | } |
94 | ||
60c514ba | 95 | cf_strcpy (iqp->access, iqp->access_len, p); |
4ee9c684 | 96 | } |
97 | ||
60c514ba | 98 | if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0) |
4ee9c684 | 99 | { |
214b69f2 | 100 | if (u == NULL) |
101 | p = inquire_sequential (NULL, 0); | |
102 | else | |
2e1fa727 | 103 | switch (u->flags.access) |
104 | { | |
105 | case ACCESS_DIRECT: | |
106 | case ACCESS_STREAM: | |
107 | p = "NO"; | |
108 | break; | |
109 | case ACCESS_SEQUENTIAL: | |
110 | p = "YES"; | |
111 | break; | |
112 | default: | |
113 | internal_error (&iqp->common, "inquire_via_unit(): Bad access"); | |
114 | } | |
4ee9c684 | 115 | |
60c514ba | 116 | cf_strcpy (iqp->sequential, iqp->sequential_len, p); |
4ee9c684 | 117 | } |
118 | ||
60c514ba | 119 | if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0) |
4ee9c684 | 120 | { |
2e1fa727 | 121 | if (u == NULL) |
122 | p = inquire_direct (NULL, 0); | |
123 | else | |
124 | switch (u->flags.access) | |
125 | { | |
126 | case ACCESS_SEQUENTIAL: | |
127 | case ACCESS_STREAM: | |
128 | p = "NO"; | |
129 | break; | |
130 | case ACCESS_DIRECT: | |
131 | p = "YES"; | |
132 | break; | |
133 | default: | |
134 | internal_error (&iqp->common, "inquire_via_unit(): Bad access"); | |
135 | } | |
4ee9c684 | 136 | |
60c514ba | 137 | cf_strcpy (iqp->direct, iqp->direct_len, p); |
4ee9c684 | 138 | } |
139 | ||
60c514ba | 140 | if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0) |
4ee9c684 | 141 | { |
142 | if (u == NULL) | |
143 | p = undefined; | |
144 | else | |
145 | switch (u->flags.form) | |
146 | { | |
147 | case FORM_FORMATTED: | |
148 | p = "FORMATTED"; | |
149 | break; | |
150 | case FORM_UNFORMATTED: | |
151 | p = "UNFORMATTED"; | |
152 | break; | |
153 | default: | |
60c514ba | 154 | internal_error (&iqp->common, "inquire_via_unit(): Bad form"); |
4ee9c684 | 155 | } |
156 | ||
60c514ba | 157 | cf_strcpy (iqp->form, iqp->form_len, p); |
4ee9c684 | 158 | } |
159 | ||
60c514ba | 160 | if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0) |
4ee9c684 | 161 | { |
2e1fa727 | 162 | if (u == NULL) |
163 | p = inquire_formatted (NULL, 0); | |
164 | else | |
165 | switch (u->flags.form) | |
166 | { | |
167 | case FORM_FORMATTED: | |
168 | p = "YES"; | |
169 | break; | |
170 | case FORM_UNFORMATTED: | |
171 | p = "NO"; | |
172 | break; | |
173 | default: | |
174 | internal_error (&iqp->common, "inquire_via_unit(): Bad form"); | |
175 | } | |
4ee9c684 | 176 | |
60c514ba | 177 | cf_strcpy (iqp->formatted, iqp->formatted_len, p); |
4ee9c684 | 178 | } |
179 | ||
60c514ba | 180 | if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0) |
4ee9c684 | 181 | { |
2e1fa727 | 182 | if (u == NULL) |
183 | p = inquire_unformatted (NULL, 0); | |
184 | else | |
185 | switch (u->flags.form) | |
186 | { | |
187 | case FORM_FORMATTED: | |
188 | p = "NO"; | |
189 | break; | |
190 | case FORM_UNFORMATTED: | |
191 | p = "YES"; | |
192 | break; | |
193 | default: | |
194 | internal_error (&iqp->common, "inquire_via_unit(): Bad form"); | |
195 | } | |
4ee9c684 | 196 | |
60c514ba | 197 | cf_strcpy (iqp->unformatted, iqp->unformatted_len, p); |
4ee9c684 | 198 | } |
199 | ||
60c514ba | 200 | if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0) |
201 | *iqp->recl_out = (u != NULL) ? u->recl : 0; | |
4ee9c684 | 202 | |
4d8ee55b | 203 | if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0) |
3c43c91f | 204 | *iqp->strm_pos_out = (u != NULL) ? u->strm_pos : 0; |
4d8ee55b | 205 | |
60c514ba | 206 | if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0) |
f4bfed80 | 207 | { |
208 | /* This only makes sense in the context of DIRECT access. */ | |
209 | if (u != NULL && u->flags.access == ACCESS_DIRECT) | |
210 | *iqp->nextrec = u->last_record + 1; | |
211 | else | |
212 | *iqp->nextrec = 0; | |
213 | } | |
4ee9c684 | 214 | |
60c514ba | 215 | if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0) |
4ee9c684 | 216 | { |
8e327405 | 217 | if (u == NULL || u->flags.form != FORM_FORMATTED) |
4ee9c684 | 218 | p = undefined; |
219 | else | |
220 | switch (u->flags.blank) | |
221 | { | |
222 | case BLANK_NULL: | |
60c514ba | 223 | p = "NULL"; |
4ee9c684 | 224 | break; |
225 | case BLANK_ZERO: | |
226 | p = "ZERO"; | |
227 | break; | |
228 | default: | |
60c514ba | 229 | internal_error (&iqp->common, "inquire_via_unit(): Bad blank"); |
4ee9c684 | 230 | } |
231 | ||
60c514ba | 232 | cf_strcpy (iqp->blank, iqp->blank_len, p); |
4ee9c684 | 233 | } |
234 | ||
8e327405 | 235 | if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0) |
236 | { | |
237 | if (u == NULL || u->flags.form != FORM_FORMATTED) | |
238 | p = undefined; | |
239 | else | |
240 | switch (u->flags.pad) | |
241 | { | |
242 | case PAD_YES: | |
243 | p = "YES"; | |
244 | break; | |
245 | case PAD_NO: | |
246 | p = "NO"; | |
247 | break; | |
248 | default: | |
249 | internal_error (&iqp->common, "inquire_via_unit(): Bad pad"); | |
250 | } | |
251 | ||
252 | cf_strcpy (iqp->pad, iqp->pad_len, p); | |
253 | } | |
254 | ||
255 | if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0) | |
256 | *iqp->pending = 0; | |
257 | ||
258 | if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0) | |
259 | *iqp->id = 0; | |
260 | ||
261 | if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) | |
262 | { | |
263 | if (u == NULL || u->flags.form != FORM_FORMATTED) | |
264 | p = undefined; | |
265 | else | |
266 | switch (u->flags.encoding) | |
267 | { | |
268 | case ENCODING_DEFAULT: | |
269 | p = "UNKNOWN"; | |
270 | break; | |
8e327405 | 271 | case ENCODING_UTF8: |
272 | p = "UTF-8"; | |
1316e8f0 | 273 | break; |
8e327405 | 274 | default: |
275 | internal_error (&iqp->common, "inquire_via_unit(): Bad encoding"); | |
276 | } | |
277 | ||
278 | cf_strcpy (iqp->encoding, iqp->encoding_len, p); | |
279 | } | |
280 | ||
281 | if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0) | |
282 | { | |
283 | if (u == NULL || u->flags.form != FORM_FORMATTED) | |
284 | p = undefined; | |
285 | else | |
286 | switch (u->flags.decimal) | |
287 | { | |
288 | case DECIMAL_POINT: | |
289 | p = "POINT"; | |
290 | break; | |
291 | case DECIMAL_COMMA: | |
292 | p = "COMMA"; | |
293 | break; | |
294 | default: | |
295 | internal_error (&iqp->common, "inquire_via_unit(): Bad comma"); | |
296 | } | |
297 | ||
298 | cf_strcpy (iqp->decimal, iqp->decimal_len, p); | |
299 | } | |
300 | ||
301 | if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0) | |
302 | { | |
303 | if (u == NULL) | |
304 | p = undefined; | |
305 | else | |
306 | switch (u->flags.async) | |
307 | { | |
308 | case ASYNC_YES: | |
309 | p = "YES"; | |
310 | break; | |
311 | case ASYNC_NO: | |
312 | p = "NO"; | |
313 | break; | |
314 | default: | |
315 | internal_error (&iqp->common, "inquire_via_unit(): Bad async"); | |
316 | } | |
317 | ||
318 | cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p); | |
319 | } | |
320 | ||
321 | if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0) | |
322 | { | |
323 | if (u == NULL) | |
324 | p = undefined; | |
325 | else | |
326 | switch (u->flags.sign) | |
327 | { | |
328 | case SIGN_PROCDEFINED: | |
329 | p = "PROCESSOR_DEFINED"; | |
330 | break; | |
331 | case SIGN_SUPPRESS: | |
332 | p = "SUPPRESS"; | |
333 | break; | |
334 | case SIGN_PLUS: | |
335 | p = "PLUS"; | |
336 | break; | |
337 | default: | |
338 | internal_error (&iqp->common, "inquire_via_unit(): Bad sign"); | |
339 | } | |
340 | ||
341 | cf_strcpy (iqp->sign, iqp->sign_len, p); | |
342 | } | |
343 | ||
344 | if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0) | |
345 | { | |
346 | if (u == NULL) | |
347 | p = undefined; | |
348 | else | |
349 | switch (u->flags.round) | |
350 | { | |
351 | case ROUND_UP: | |
352 | p = "UP"; | |
353 | break; | |
354 | case ROUND_DOWN: | |
355 | p = "DOWN"; | |
356 | break; | |
357 | case ROUND_ZERO: | |
358 | p = "ZERO"; | |
359 | break; | |
360 | case ROUND_NEAREST: | |
361 | p = "NEAREST"; | |
362 | break; | |
363 | case ROUND_COMPATIBLE: | |
364 | p = "COMPATIBLE"; | |
365 | break; | |
366 | case ROUND_PROCDEFINED: | |
367 | p = "PROCESSOR_DEFINED"; | |
368 | break; | |
369 | default: | |
370 | internal_error (&iqp->common, "inquire_via_unit(): Bad round"); | |
371 | } | |
372 | ||
373 | cf_strcpy (iqp->round, iqp->round_len, p); | |
374 | } | |
375 | ||
60c514ba | 376 | if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0) |
4ee9c684 | 377 | { |
378 | if (u == NULL || u->flags.access == ACCESS_DIRECT) | |
b3b0377b | 379 | p = undefined; |
4ee9c684 | 380 | else |
b3b0377b | 381 | switch (u->flags.position) |
382 | { | |
383 | case POSITION_REWIND: | |
384 | p = "REWIND"; | |
385 | break; | |
386 | case POSITION_APPEND: | |
387 | p = "APPEND"; | |
388 | break; | |
389 | case POSITION_ASIS: | |
390 | p = "ASIS"; | |
391 | break; | |
392 | default: | |
393 | /* if not direct access, it must be | |
394 | either REWIND, APPEND, or ASIS. | |
395 | ASIS seems to be the best default */ | |
396 | p = "ASIS"; | |
397 | break; | |
398 | } | |
60c514ba | 399 | cf_strcpy (iqp->position, iqp->position_len, p); |
4ee9c684 | 400 | } |
401 | ||
60c514ba | 402 | if ((cf & IOPARM_INQUIRE_HAS_ACTION) != 0) |
4ee9c684 | 403 | { |
404 | if (u == NULL) | |
405 | p = undefined; | |
406 | else | |
407 | switch (u->flags.action) | |
408 | { | |
409 | case ACTION_READ: | |
410 | p = "READ"; | |
411 | break; | |
412 | case ACTION_WRITE: | |
413 | p = "WRITE"; | |
414 | break; | |
415 | case ACTION_READWRITE: | |
416 | p = "READWRITE"; | |
417 | break; | |
418 | default: | |
60c514ba | 419 | internal_error (&iqp->common, "inquire_via_unit(): Bad action"); |
4ee9c684 | 420 | } |
421 | ||
60c514ba | 422 | cf_strcpy (iqp->action, iqp->action_len, p); |
4ee9c684 | 423 | } |
424 | ||
60c514ba | 425 | if ((cf & IOPARM_INQUIRE_HAS_READ) != 0) |
4ee9c684 | 426 | { |
427 | p = (u == NULL) ? inquire_read (NULL, 0) : | |
428 | inquire_read (u->file, u->file_len); | |
429 | ||
60c514ba | 430 | cf_strcpy (iqp->read, iqp->read_len, p); |
4ee9c684 | 431 | } |
432 | ||
60c514ba | 433 | if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0) |
4ee9c684 | 434 | { |
435 | p = (u == NULL) ? inquire_write (NULL, 0) : | |
436 | inquire_write (u->file, u->file_len); | |
437 | ||
60c514ba | 438 | cf_strcpy (iqp->write, iqp->write_len, p); |
4ee9c684 | 439 | } |
440 | ||
60c514ba | 441 | if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0) |
4ee9c684 | 442 | { |
443 | p = (u == NULL) ? inquire_readwrite (NULL, 0) : | |
444 | inquire_readwrite (u->file, u->file_len); | |
445 | ||
60c514ba | 446 | cf_strcpy (iqp->readwrite, iqp->readwrite_len, p); |
4ee9c684 | 447 | } |
448 | ||
60c514ba | 449 | if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0) |
4ee9c684 | 450 | { |
451 | if (u == NULL || u->flags.form != FORM_FORMATTED) | |
452 | p = undefined; | |
453 | else | |
454 | switch (u->flags.delim) | |
455 | { | |
456 | case DELIM_NONE: | |
457 | p = "NONE"; | |
458 | break; | |
459 | case DELIM_QUOTE: | |
460 | p = "QUOTE"; | |
461 | break; | |
462 | case DELIM_APOSTROPHE: | |
463 | p = "APOSTROPHE"; | |
464 | break; | |
465 | default: | |
60c514ba | 466 | internal_error (&iqp->common, "inquire_via_unit(): Bad delim"); |
4ee9c684 | 467 | } |
468 | ||
60c514ba | 469 | cf_strcpy (iqp->delim, iqp->delim_len, p); |
4ee9c684 | 470 | } |
471 | ||
60c514ba | 472 | if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0) |
4ee9c684 | 473 | { |
474 | if (u == NULL || u->flags.form != FORM_FORMATTED) | |
475 | p = undefined; | |
476 | else | |
477 | switch (u->flags.pad) | |
478 | { | |
479 | case PAD_NO: | |
480 | p = "NO"; | |
481 | break; | |
482 | case PAD_YES: | |
483 | p = "YES"; | |
484 | break; | |
485 | default: | |
60c514ba | 486 | internal_error (&iqp->common, "inquire_via_unit(): Bad pad"); |
4ee9c684 | 487 | } |
488 | ||
60c514ba | 489 | cf_strcpy (iqp->pad, iqp->pad_len, p); |
4ee9c684 | 490 | } |
9e94d29f | 491 | |
492 | if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0) | |
493 | { | |
494 | if (u == NULL) | |
495 | p = undefined; | |
496 | else | |
497 | switch (u->flags.convert) | |
498 | { | |
1316e8f0 | 499 | /* big_endian is 0 for little-endian, 1 for big-endian. */ |
18f0b7df | 500 | case GFC_CONVERT_NATIVE: |
1316e8f0 | 501 | p = big_endian ? "BIG_ENDIAN" : "LITTLE_ENDIAN"; |
9e94d29f | 502 | break; |
503 | ||
18f0b7df | 504 | case GFC_CONVERT_SWAP: |
1316e8f0 | 505 | p = big_endian ? "LITTLE_ENDIAN" : "BIG_ENDIAN"; |
9e94d29f | 506 | break; |
507 | ||
508 | default: | |
509 | internal_error (&iqp->common, "inquire_via_unit(): Bad convert"); | |
510 | } | |
511 | ||
512 | cf_strcpy (iqp->convert, iqp->convert_len, p); | |
513 | } | |
4ee9c684 | 514 | } |
515 | ||
516 | ||
517 | /* inquire_via_filename()-- Inquiry via filename. This subroutine is | |
518 | * only used if the filename is *not* connected to a unit number. */ | |
519 | ||
520 | static void | |
60c514ba | 521 | inquire_via_filename (st_parameter_inquire *iqp) |
4ee9c684 | 522 | { |
523 | const char *p; | |
60c514ba | 524 | GFC_INTEGER_4 cf = iqp->common.flags; |
8e327405 | 525 | GFC_INTEGER_4 cf2 = iqp->flags2; |
4ee9c684 | 526 | |
60c514ba | 527 | if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) |
528 | *iqp->exist = file_exists (iqp->file, iqp->file_len); | |
4ee9c684 | 529 | |
60c514ba | 530 | if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0) |
531 | *iqp->opened = 0; | |
4ee9c684 | 532 | |
60c514ba | 533 | if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0) |
534 | *iqp->number = -1; | |
4ee9c684 | 535 | |
60c514ba | 536 | if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0) |
537 | *iqp->named = 1; | |
4ee9c684 | 538 | |
60c514ba | 539 | if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0) |
540 | fstrcpy (iqp->name, iqp->name_len, iqp->file, iqp->file_len); | |
4ee9c684 | 541 | |
60c514ba | 542 | if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0) |
543 | cf_strcpy (iqp->access, iqp->access_len, undefined); | |
4ee9c684 | 544 | |
60c514ba | 545 | if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0) |
4ee9c684 | 546 | { |
2e1fa727 | 547 | p = "UNKNOWN"; |
60c514ba | 548 | cf_strcpy (iqp->sequential, iqp->sequential_len, p); |
4ee9c684 | 549 | } |
550 | ||
60c514ba | 551 | if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0) |
4ee9c684 | 552 | { |
2e1fa727 | 553 | p = "UNKNOWN"; |
60c514ba | 554 | cf_strcpy (iqp->direct, iqp->direct_len, p); |
4ee9c684 | 555 | } |
556 | ||
60c514ba | 557 | if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0) |
558 | cf_strcpy (iqp->form, iqp->form_len, undefined); | |
4ee9c684 | 559 | |
60c514ba | 560 | if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0) |
4ee9c684 | 561 | { |
2e1fa727 | 562 | p = "UNKNOWN"; |
60c514ba | 563 | cf_strcpy (iqp->formatted, iqp->formatted_len, p); |
4ee9c684 | 564 | } |
565 | ||
60c514ba | 566 | if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0) |
4ee9c684 | 567 | { |
2e1fa727 | 568 | p = "UNKNOWN"; |
60c514ba | 569 | cf_strcpy (iqp->unformatted, iqp->unformatted_len, p); |
4ee9c684 | 570 | } |
571 | ||
60c514ba | 572 | if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0) |
573 | *iqp->recl_out = 0; | |
4ee9c684 | 574 | |
60c514ba | 575 | if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0) |
576 | *iqp->nextrec = 0; | |
4ee9c684 | 577 | |
60c514ba | 578 | if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0) |
579 | cf_strcpy (iqp->blank, iqp->blank_len, undefined); | |
4ee9c684 | 580 | |
8e327405 | 581 | if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0) |
582 | cf_strcpy (iqp->pad, iqp->pad_len, undefined); | |
583 | ||
584 | if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) | |
585 | cf_strcpy (iqp->encoding, iqp->encoding_len, undefined); | |
586 | ||
587 | if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0) | |
588 | cf_strcpy (iqp->delim, iqp->delim_len, undefined); | |
589 | ||
590 | if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0) | |
591 | cf_strcpy (iqp->decimal, iqp->decimal_len, undefined); | |
592 | ||
60c514ba | 593 | if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0) |
594 | cf_strcpy (iqp->position, iqp->position_len, undefined); | |
4ee9c684 | 595 | |
60c514ba | 596 | if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0) |
597 | cf_strcpy (iqp->access, iqp->access_len, undefined); | |
4ee9c684 | 598 | |
60c514ba | 599 | if ((cf & IOPARM_INQUIRE_HAS_READ) != 0) |
4ee9c684 | 600 | { |
60c514ba | 601 | p = inquire_read (iqp->file, iqp->file_len); |
602 | cf_strcpy (iqp->read, iqp->read_len, p); | |
4ee9c684 | 603 | } |
604 | ||
60c514ba | 605 | if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0) |
4ee9c684 | 606 | { |
60c514ba | 607 | p = inquire_write (iqp->file, iqp->file_len); |
608 | cf_strcpy (iqp->write, iqp->write_len, p); | |
4ee9c684 | 609 | } |
610 | ||
60c514ba | 611 | if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0) |
4ee9c684 | 612 | { |
60c514ba | 613 | p = inquire_read (iqp->file, iqp->file_len); |
614 | cf_strcpy (iqp->readwrite, iqp->readwrite_len, p); | |
4ee9c684 | 615 | } |
616 | ||
8e327405 | 617 | if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0) |
60c514ba | 618 | cf_strcpy (iqp->delim, iqp->delim_len, undefined); |
4ee9c684 | 619 | |
8e327405 | 620 | if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0) |
60c514ba | 621 | cf_strcpy (iqp->pad, iqp->pad_len, undefined); |
8e327405 | 622 | |
623 | if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) | |
624 | cf_strcpy (iqp->encoding, iqp->encoding_len, undefined); | |
4ee9c684 | 625 | } |
626 | ||
627 | ||
6799e2f8 | 628 | /* Library entry point for the INQUIRE statement (non-IOLENGTH |
629 | form). */ | |
4ee9c684 | 630 | |
60c514ba | 631 | extern void st_inquire (st_parameter_inquire *); |
7b6cb5bd | 632 | export_proto(st_inquire); |
633 | ||
4ee9c684 | 634 | void |
60c514ba | 635 | st_inquire (st_parameter_inquire *iqp) |
4ee9c684 | 636 | { |
f02dd226 | 637 | gfc_unit *u; |
4ee9c684 | 638 | |
60c514ba | 639 | library_start (&iqp->common); |
4ee9c684 | 640 | |
60c514ba | 641 | if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0) |
642 | { | |
643 | u = find_unit (iqp->common.unit); | |
644 | inquire_via_unit (iqp, u); | |
645 | } | |
4ee9c684 | 646 | else |
647 | { | |
60c514ba | 648 | u = find_file (iqp->file, iqp->file_len); |
4ee9c684 | 649 | if (u == NULL) |
60c514ba | 650 | inquire_via_filename (iqp); |
4ee9c684 | 651 | else |
60c514ba | 652 | inquire_via_unit (iqp, u); |
4ee9c684 | 653 | } |
60c514ba | 654 | if (u != NULL) |
655 | unlock_unit (u); | |
4ee9c684 | 656 | |
657 | library_end (); | |
658 | } |