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