1 /* Copyright (C) 2002-2023 Free Software Foundation, Inc.
2 Contributed by Andy Vaught
3
4 This file is part of the GNU Fortran 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 3, 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 Under Section 7 of GPL version 3, you are granted additional
17 permissions described in the GCC Runtime Library Exception, version
18 3.1, as published by the Free Software Foundation.
19
20 You should have received a copy of the GNU General Public License and
21 a copy of the GCC Runtime Library Exception along with this program;
22 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
23 <http://www.gnu.org/licenses/>. */
24
25
26 /* Implement the non-IOLENGTH variant of the INQUIRY statement */
27
28 #include "io.h"
29 #include "async.h"
30 #include "unix.h"
31 #include <string.h>
32
33
34 static const char yes[] = "YES", no[] = "NO", undefined[] = "UNDEFINED";
35
36
37 /* inquire_via_unit()-- Inquiry via unit number. The unit might not exist. */
38
39 static void
40 inquire_via_unit (st_parameter_inquire *iqp, gfc_unit *u)
41 {
42 const char *p;
43 GFC_INTEGER_4 cf = iqp->common.flags;
44
45 if (iqp->common.unit == GFC_INTERNAL_UNIT ||
46 iqp->common.unit == GFC_INTERNAL_UNIT4 ||
47 (u != NULL && u->internal_unit_kind != 0))
48 generate_error (&iqp->common, LIBERROR_INQUIRE_INTERNAL_UNIT, NULL);
49
50 if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
51 *iqp->exist = (u != NULL &&
52 iqp->common.unit != GFC_INTERNAL_UNIT &&
53 iqp->common.unit != GFC_INTERNAL_UNIT4)
54 || (iqp->common.unit >= 0);
55
56 if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
57 *iqp->opened = (u != NULL);
58
59 if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
60 *iqp->number = (u != NULL) ? u->unit_number : -1;
61
62 if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
63 *iqp->named = (u != NULL && u->flags.status != STATUS_SCRATCH);
64
65 if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0
66 && u != NULL && u->flags.status != STATUS_SCRATCH)
67 {
68 #if defined(HAVE_TTYNAME_R) || defined(HAVE_TTYNAME)
69 if (u->unit_number == options.stdin_unit
70 || u->unit_number == options.stdout_unit
71 || u->unit_number == options.stderr_unit)
72 {
73 int err = stream_ttyname (u->s, iqp->name, iqp->name_len);
74 if (err == 0)
75 {
76 gfc_charlen_type tmplen = strlen (iqp->name);
77 if (iqp->name_len > tmplen)
78 memset (&iqp->name[tmplen], ' ', iqp->name_len - tmplen);
79 }
80 else /* If ttyname does not work, go with the default. */
81 cf_strcpy (iqp->name, iqp->name_len, u->filename);
82 }
83 else
84 cf_strcpy (iqp->name, iqp->name_len, u->filename);
85 #elif defined __MINGW32__
86 if (u->unit_number == options.stdin_unit)
87 fstrcpy (iqp->name, iqp->name_len, "CONIN$", sizeof("CONIN$"));
88 else if (u->unit_number == options.stdout_unit)
89 fstrcpy (iqp->name, iqp->name_len, "CONOUT$", sizeof("CONOUT$"));
90 else if (u->unit_number == options.stderr_unit)
91 fstrcpy (iqp->name, iqp->name_len, "CONERR$", sizeof("CONERR$"));
92 else
93 cf_strcpy (iqp->name, iqp->name_len, u->filename);
94 #else
95 cf_strcpy (iqp->name, iqp->name_len, u->filename);
96 #endif
97 }
98
99 if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
100 {
101 if (u == NULL)
102 p = undefined;
103 else
104 switch (u->flags.access)
105 {
106 case ACCESS_SEQUENTIAL:
107 p = "SEQUENTIAL";
108 break;
109 case ACCESS_DIRECT:
110 p = "DIRECT";
111 break;
112 case ACCESS_STREAM:
113 p = "STREAM";
114 break;
115 default:
116 internal_error (&iqp->common, "inquire_via_unit(): Bad access");
117 }
118
119 cf_strcpy (iqp->access, iqp->access_len, p);
120 }
121
122 if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
123 {
124 if (u == NULL)
125 p = inquire_sequential (NULL, 0);
126 else
127 switch (u->flags.access)
128 {
129 case ACCESS_DIRECT:
130 case ACCESS_STREAM:
131 p = no;
132 break;
133 case ACCESS_SEQUENTIAL:
134 p = yes;
135 break;
136 default:
137 internal_error (&iqp->common, "inquire_via_unit(): Bad access");
138 }
139
140 cf_strcpy (iqp->sequential, iqp->sequential_len, p);
141 }
142
143 if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
144 {
145 if (u == NULL)
146 p = inquire_direct (NULL, 0);
147 else
148 switch (u->flags.access)
149 {
150 case ACCESS_SEQUENTIAL:
151 case ACCESS_STREAM:
152 p = no;
153 break;
154 case ACCESS_DIRECT:
155 p = yes;
156 break;
157 default:
158 internal_error (&iqp->common, "inquire_via_unit(): Bad access");
159 }
160
161 cf_strcpy (iqp->direct, iqp->direct_len, p);
162 }
163
164 if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
165 {
166 if (u == NULL)
167 p = undefined;
168 else
169 switch (u->flags.form)
170 {
171 case FORM_FORMATTED:
172 p = "FORMATTED";
173 break;
174 case FORM_UNFORMATTED:
175 p = "UNFORMATTED";
176 break;
177 default:
178 internal_error (&iqp->common, "inquire_via_unit(): Bad form");
179 }
180
181 cf_strcpy (iqp->form, iqp->form_len, p);
182 }
183
184 if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
185 {
186 if (u == NULL)
187 p = inquire_formatted (NULL, 0);
188 else
189 switch (u->flags.form)
190 {
191 case FORM_FORMATTED:
192 p = yes;
193 break;
194 case FORM_UNFORMATTED:
195 p = no;
196 break;
197 default:
198 internal_error (&iqp->common, "inquire_via_unit(): Bad form");
199 }
200
201 cf_strcpy (iqp->formatted, iqp->formatted_len, p);
202 }
203
204 if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
205 {
206 if (u == NULL)
207 p = inquire_unformatted (NULL, 0);
208 else
209 switch (u->flags.form)
210 {
211 case FORM_FORMATTED:
212 p = no;
213 break;
214 case FORM_UNFORMATTED:
215 p = yes;
216 break;
217 default:
218 internal_error (&iqp->common, "inquire_via_unit(): Bad form");
219 }
220
221 cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
222 }
223
224 if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
225 /* F2018 (N2137) 12.10.2.26: If there is no connection, recl is
226 assigned the value -1. */
227 *iqp->recl_out = (u != NULL) ? u->recl : -1;
228
229 if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0)
230 *iqp->strm_pos_out = (u != NULL) ? u->strm_pos : 0;
231
232 if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
233 {
234 /* This only makes sense in the context of DIRECT access. */
235 if (u != NULL && u->flags.access == ACCESS_DIRECT)
236 *iqp->nextrec = u->last_record + 1;
237 else
238 *iqp->nextrec = 0;
239 }
240
241 if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
242 {
243 if (u == NULL || u->flags.form != FORM_FORMATTED)
244 p = undefined;
245 else
246 switch (u->flags.blank)
247 {
248 case BLANK_NULL:
249 p = "NULL";
250 break;
251 case BLANK_ZERO:
252 p = "ZERO";
253 break;
254 default:
255 internal_error (&iqp->common, "inquire_via_unit(): Bad blank");
256 }
257
258 cf_strcpy (iqp->blank, iqp->blank_len, p);
259 }
260
261 if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
262 {
263 if (u == NULL || u->flags.form != FORM_FORMATTED)
264 p = undefined;
265 else
266 switch (u->flags.pad)
267 {
268 case PAD_YES:
269 p = yes;
270 break;
271 case PAD_NO:
272 p = no;
273 break;
274 default:
275 internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
276 }
277
278 cf_strcpy (iqp->pad, iqp->pad_len, p);
279 }
280
281 if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
282 {
283 GFC_INTEGER_4 cf2 = iqp->flags2;
284
285 if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
286 {
287 if (u == NULL || u->flags.form != FORM_FORMATTED)
288 p = undefined;
289 else
290 switch (u->flags.encoding)
291 {
292 case ENCODING_DEFAULT:
293 p = "UNKNOWN";
294 break;
295 case ENCODING_UTF8:
296 p = "UTF-8";
297 break;
298 default:
299 internal_error (&iqp->common, "inquire_via_unit(): Bad encoding");
300 }
301
302 cf_strcpy (iqp->encoding, iqp->encoding_len, p);
303 }
304
305 if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
306 {
307 if (u == NULL || u->flags.form != FORM_FORMATTED)
308 p = undefined;
309 else
310 switch (u->flags.decimal)
311 {
312 case DECIMAL_POINT:
313 p = "POINT";
314 break;
315 case DECIMAL_COMMA:
316 p = "COMMA";
317 break;
318 default:
319 internal_error (&iqp->common, "inquire_via_unit(): Bad comma");
320 }
321
322 cf_strcpy (iqp->decimal, iqp->decimal_len, p);
323 }
324
325 if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0)
326 {
327 if (u == NULL)
328 p = undefined;
329 else
330 {
331 switch (u->flags.async)
332 {
333 case ASYNC_YES:
334 p = yes;
335 break;
336 case ASYNC_NO:
337 p = no;
338 break;
339 default:
340 internal_error (&iqp->common, "inquire_via_unit(): Bad async");
341 }
342 }
343 cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p);
344 }
345
346 if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0)
347 {
348 if (!ASYNC_IO || u->au == NULL)
349 *(iqp->pending) = 0;
350 else
351 {
352 LOCK (&(u->au->lock));
353 if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0)
354 {
355 int id;
356 id = *(iqp->id);
357 *(iqp->pending) = id > u->au->id.low;
358 }
359 else
360 {
361 *(iqp->pending) = ! u->au->empty;
362 }
363 UNLOCK (&(u->au->lock));
364 }
365 }
366
367 if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0)
368 {
369 if (u == NULL)
370 p = undefined;
371 else
372 switch (u->flags.sign)
373 {
374 case SIGN_PROCDEFINED:
375 p = "PROCESSOR_DEFINED";
376 break;
377 case SIGN_SUPPRESS:
378 p = "SUPPRESS";
379 break;
380 case SIGN_PLUS:
381 p = "PLUS";
382 break;
383 default:
384 internal_error (&iqp->common, "inquire_via_unit(): Bad sign");
385 }
386
387 cf_strcpy (iqp->sign, iqp->sign_len, p);
388 }
389
390 if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0)
391 {
392 if (u == NULL)
393 p = undefined;
394 else
395 switch (u->flags.round)
396 {
397 case ROUND_UP:
398 p = "UP";
399 break;
400 case ROUND_DOWN:
401 p = "DOWN";
402 break;
403 case ROUND_ZERO:
404 p = "ZERO";
405 break;
406 case ROUND_NEAREST:
407 p = "NEAREST";
408 break;
409 case ROUND_COMPATIBLE:
410 p = "COMPATIBLE";
411 break;
412 case ROUND_PROCDEFINED:
413 p = "PROCESSOR_DEFINED";
414 break;
415 default:
416 internal_error (&iqp->common, "inquire_via_unit(): Bad round");
417 }
418
419 cf_strcpy (iqp->round, iqp->round_len, p);
420 }
421
422 if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
423 {
424 if (u == NULL)
425 *iqp->size = -1;
426 else
427 {
428 sflush (u->s);
429 *iqp->size = ssize (u->s);
430 }
431 }
432
433 if ((cf2 & IOPARM_INQUIRE_HAS_IQSTREAM) != 0)
434 {
435 if (u == NULL)
436 p = "UNKNOWN";
437 else
438 switch (u->flags.access)
439 {
440 case ACCESS_SEQUENTIAL:
441 case ACCESS_DIRECT:
442 p = no;
443 break;
444 case ACCESS_STREAM:
445 p = yes;
446 break;
447 default:
448 internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
449 }
450
451 cf_strcpy (iqp->iqstream, iqp->iqstream_len, p);
452 }
453
454 if ((cf2 & IOPARM_INQUIRE_HAS_SHARE) != 0)
455 {
456 if (u == NULL)
457 p = "UNKNOWN";
458 else
459 switch (u->flags.share)
460 {
461 case SHARE_DENYRW:
462 p = "DENYRW";
463 break;
464 case SHARE_DENYNONE:
465 p = "DENYNONE";
466 break;
467 case SHARE_UNSPECIFIED:
468 p = "NODENY";
469 break;
470 default:
471 internal_error (&iqp->common,
472 "inquire_via_unit(): Bad share");
473 break;
474 }
475
476 cf_strcpy (iqp->share, iqp->share_len, p);
477 }
478
479 if ((cf2 & IOPARM_INQUIRE_HAS_CC) != 0)
480 {
481 if (u == NULL)
482 p = "UNKNOWN";
483 else
484 switch (u->flags.cc)
485 {
486 case CC_FORTRAN:
487 p = "FORTRAN";
488 break;
489 case CC_LIST:
490 p = "LIST";
491 break;
492 case CC_NONE:
493 p = "NONE";
494 break;
495 case CC_UNSPECIFIED:
496 p = "UNKNOWN";
497 break;
498 default:
499 internal_error (&iqp->common, "inquire_via_unit(): Bad cc");
500 break;
501 }
502
503 cf_strcpy (iqp->cc, iqp->cc_len, p);
504 }
505 }
506
507 if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
508 {
509 if (u == NULL || u->flags.access == ACCESS_DIRECT)
510 p = undefined;
511 else
512 {
513 /* If the position is unspecified, check if we can figure
514 out whether it's at the beginning or end. */
515 if (u->flags.position == POSITION_UNSPECIFIED)
516 {
517 gfc_offset cur = stell (u->s);
518 if (cur == 0)
519 u->flags.position = POSITION_REWIND;
520 else if (cur != -1 && (ssize (u->s) == cur))
521 u->flags.position = POSITION_APPEND;
522 }
523 switch (u->flags.position)
524 {
525 case POSITION_REWIND:
526 p = "REWIND";
527 break;
528 case POSITION_APPEND:
529 p = "APPEND";
530 break;
531 case POSITION_ASIS:
532 p = "ASIS";
533 break;
534 default:
535 /* If the position has changed and is not rewind or
536 append, it must be set to a processor-dependent
537 value. */
538 p = "UNSPECIFIED";
539 break;
540 }
541 }
542 cf_strcpy (iqp->position, iqp->position_len, p);
543 }
544
545 if ((cf & IOPARM_INQUIRE_HAS_ACTION) != 0)
546 {
547 if (u == NULL)
548 p = undefined;
549 else
550 switch (u->flags.action)
551 {
552 case ACTION_READ:
553 p = "READ";
554 break;
555 case ACTION_WRITE:
556 p = "WRITE";
557 break;
558 case ACTION_READWRITE:
559 p = "READWRITE";
560 break;
561 default:
562 internal_error (&iqp->common, "inquire_via_unit(): Bad action");
563 }
564
565 cf_strcpy (iqp->action, iqp->action_len, p);
566 }
567
568 if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
569 {
570 p = (!u || u->flags.action == ACTION_WRITE) ? no : yes;
571 cf_strcpy (iqp->read, iqp->read_len, p);
572 }
573
574 if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
575 {
576 p = (!u || u->flags.action == ACTION_READ) ? no : yes;
577 cf_strcpy (iqp->write, iqp->write_len, p);
578 }
579
580 if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
581 {
582 p = (!u || u->flags.action != ACTION_READWRITE) ? no : yes;
583 cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
584 }
585
586 if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0)
587 {
588 if (u == NULL || u->flags.form != FORM_FORMATTED)
589 p = undefined;
590 else
591 switch (u->flags.delim)
592 {
593 case DELIM_NONE:
594 case DELIM_UNSPECIFIED:
595 p = "NONE";
596 break;
597 case DELIM_QUOTE:
598 p = "QUOTE";
599 break;
600 case DELIM_APOSTROPHE:
601 p = "APOSTROPHE";
602 break;
603 default:
604 internal_error (&iqp->common, "inquire_via_unit(): Bad delim");
605 }
606
607 cf_strcpy (iqp->delim, iqp->delim_len, p);
608 }
609
610 if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
611 {
612 if (u == NULL || u->flags.form != FORM_FORMATTED)
613 p = undefined;
614 else
615 switch (u->flags.pad)
616 {
617 case PAD_NO:
618 p = no;
619 break;
620 case PAD_YES:
621 p = yes;
622 break;
623 default:
624 internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
625 }
626
627 cf_strcpy (iqp->pad, iqp->pad_len, p);
628 }
629
630 if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0)
631 {
632 if (u == NULL)
633 p = undefined;
634 else
635 switch (u->flags.convert)
636 {
637 case GFC_CONVERT_NATIVE:
638 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
639 break;
640
641 case GFC_CONVERT_SWAP:
642 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
643 break;
644
645 #ifdef HAVE_GFC_REAL_17
646 case GFC_CONVERT_NATIVE | GFC_CONVERT_R16_IEEE:
647 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "BIG_ENDIAN,R16_IEEE" : "LITTLE_ENDIAN,R16_IEEE";
648 break;
649
650 case GFC_CONVERT_SWAP | GFC_CONVERT_R16_IEEE:
651 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN,R16_IEEE" : "BIG_ENDIAN,R16_IEEE";
652 break;
653
654 case GFC_CONVERT_NATIVE | GFC_CONVERT_R16_IBM:
655 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "BIG_ENDIAN,R16_IBM" : "LITTLE_ENDIAN,R16_IBM";
656 break;
657
658 case GFC_CONVERT_SWAP | GFC_CONVERT_R16_IBM:
659 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN,R16_IBM" : "BIG_ENDIAN,R16_IBM";
660 break;
661 #endif
662
663 default:
664 internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
665 }
666
667 cf_strcpy (iqp->convert, iqp->convert_len, p);
668 }
669 }
670
671
672 /* inquire_via_filename()-- Inquiry via filename. This subroutine is
673 only used if the filename is *not* connected to a unit number. */
674
675 static void
676 inquire_via_filename (st_parameter_inquire *iqp)
677 {
678 const char *p;
679 GFC_INTEGER_4 cf = iqp->common.flags;
680
681 if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
682 *iqp->exist = file_exists (iqp->file, iqp->file_len);
683
684 if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
685 *iqp->opened = 0;
686
687 if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
688 *iqp->number = -1;
689
690 if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
691 *iqp->named = 1;
692
693 if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0)
694 fstrcpy (iqp->name, iqp->name_len, iqp->file, iqp->file_len);
695
696 if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
697 cf_strcpy (iqp->access, iqp->access_len, undefined);
698
699 if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
700 {
701 p = "UNKNOWN";
702 cf_strcpy (iqp->sequential, iqp->sequential_len, p);
703 }
704
705 if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
706 {
707 p = "UNKNOWN";
708 cf_strcpy (iqp->direct, iqp->direct_len, p);
709 }
710
711 if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
712 cf_strcpy (iqp->form, iqp->form_len, undefined);
713
714 if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
715 {
716 p = "UNKNOWN";
717 cf_strcpy (iqp->formatted, iqp->formatted_len, p);
718 }
719
720 if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
721 {
722 p = "UNKNOWN";
723 cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
724 }
725
726 if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
727 /* F2018 (N2137) 12.10.2.26: If there is no connection, recl is
728 assigned the value -1. */
729 *iqp->recl_out = -1;
730
731 if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
732 *iqp->nextrec = 0;
733
734 if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
735 cf_strcpy (iqp->blank, iqp->blank_len, undefined);
736
737 if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
738 cf_strcpy (iqp->pad, iqp->pad_len, undefined);
739
740 if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
741 {
742 GFC_INTEGER_4 cf2 = iqp->flags2;
743
744 if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
745 cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
746
747 if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
748 cf_strcpy (iqp->delim, iqp->delim_len, undefined);
749
750 if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
751 cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);
752
753 if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
754 cf_strcpy (iqp->delim, iqp->delim_len, undefined);
755
756 if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
757 cf_strcpy (iqp->pad, iqp->pad_len, undefined);
758
759 if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
760 cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
761
762 if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
763 *iqp->size = file_size (iqp->file, iqp->file_len);
764
765 if ((cf2 & IOPARM_INQUIRE_HAS_IQSTREAM) != 0)
766 cf_strcpy (iqp->iqstream, iqp->iqstream_len, "UNKNOWN");
767
768 if ((cf2 & IOPARM_INQUIRE_HAS_SHARE) != 0)
769 cf_strcpy (iqp->share, iqp->share_len, "UNKNOWN");
770
771 if ((cf2 & IOPARM_INQUIRE_HAS_CC) != 0)
772 cf_strcpy (iqp->cc, iqp->cc_len, "UNKNOWN");
773 }
774
775 if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
776 cf_strcpy (iqp->position, iqp->position_len, undefined);
777
778 if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
779 cf_strcpy (iqp->access, iqp->access_len, undefined);
780
781 if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
782 {
783 p = inquire_read (iqp->file, iqp->file_len);
784 cf_strcpy (iqp->read, iqp->read_len, p);
785 }
786
787 if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
788 {
789 p = inquire_write (iqp->file, iqp->file_len);
790 cf_strcpy (iqp->write, iqp->write_len, p);
791 }
792
793 if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
794 {
795 p = inquire_read (iqp->file, iqp->file_len);
796 cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
797 }
798 }
799
800
801 /* Library entry point for the INQUIRE statement (non-IOLENGTH
802 form). */
803
804 extern void st_inquire (st_parameter_inquire *);
805 export_proto(st_inquire);
806
807 void
808 st_inquire (st_parameter_inquire *iqp)
809 {
810 gfc_unit *u;
811
812 library_start (&iqp->common);
813
814 if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0)
815 {
816 u = find_unit (iqp->common.unit);
817 inquire_via_unit (iqp, u);
818 }
819 else
820 {
821 u = find_file (iqp->file, iqp->file_len);
822 if (u == NULL)
823 inquire_via_filename (iqp);
824 else
825 inquire_via_unit (iqp, u);
826 }
827 if (u != NULL)
828 unlock_unit (u);
829
830 library_end ();
831 }