1 /* Copyright (C) 2002-2020 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
inquire_via_unit(st_parameter_inquire * iqp,gfc_unit * u)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 default:
646 internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
647 }
648
649 cf_strcpy (iqp->convert, iqp->convert_len, p);
650 }
651 }
652
653
654 /* inquire_via_filename()-- Inquiry via filename. This subroutine is
655 only used if the filename is *not* connected to a unit number. */
656
657 static void
inquire_via_filename(st_parameter_inquire * iqp)658 inquire_via_filename (st_parameter_inquire *iqp)
659 {
660 const char *p;
661 GFC_INTEGER_4 cf = iqp->common.flags;
662
663 if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
664 *iqp->exist = file_exists (iqp->file, iqp->file_len);
665
666 if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
667 *iqp->opened = 0;
668
669 if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
670 *iqp->number = -1;
671
672 if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
673 *iqp->named = 1;
674
675 if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0)
676 fstrcpy (iqp->name, iqp->name_len, iqp->file, iqp->file_len);
677
678 if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
679 cf_strcpy (iqp->access, iqp->access_len, undefined);
680
681 if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
682 {
683 p = "UNKNOWN";
684 cf_strcpy (iqp->sequential, iqp->sequential_len, p);
685 }
686
687 if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
688 {
689 p = "UNKNOWN";
690 cf_strcpy (iqp->direct, iqp->direct_len, p);
691 }
692
693 if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
694 cf_strcpy (iqp->form, iqp->form_len, undefined);
695
696 if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
697 {
698 p = "UNKNOWN";
699 cf_strcpy (iqp->formatted, iqp->formatted_len, p);
700 }
701
702 if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
703 {
704 p = "UNKNOWN";
705 cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
706 }
707
708 if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
709 /* F2018 (N2137) 12.10.2.26: If there is no connection, recl is
710 assigned the value -1. */
711 *iqp->recl_out = -1;
712
713 if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
714 *iqp->nextrec = 0;
715
716 if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
717 cf_strcpy (iqp->blank, iqp->blank_len, undefined);
718
719 if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
720 cf_strcpy (iqp->pad, iqp->pad_len, undefined);
721
722 if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
723 {
724 GFC_INTEGER_4 cf2 = iqp->flags2;
725
726 if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
727 cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
728
729 if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
730 cf_strcpy (iqp->delim, iqp->delim_len, undefined);
731
732 if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
733 cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);
734
735 if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
736 cf_strcpy (iqp->delim, iqp->delim_len, undefined);
737
738 if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
739 cf_strcpy (iqp->pad, iqp->pad_len, undefined);
740
741 if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
742 cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
743
744 if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
745 *iqp->size = file_size (iqp->file, iqp->file_len);
746
747 if ((cf2 & IOPARM_INQUIRE_HAS_IQSTREAM) != 0)
748 cf_strcpy (iqp->iqstream, iqp->iqstream_len, "UNKNOWN");
749
750 if ((cf2 & IOPARM_INQUIRE_HAS_SHARE) != 0)
751 cf_strcpy (iqp->share, iqp->share_len, "UNKNOWN");
752
753 if ((cf2 & IOPARM_INQUIRE_HAS_CC) != 0)
754 cf_strcpy (iqp->cc, iqp->cc_len, "UNKNOWN");
755 }
756
757 if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
758 cf_strcpy (iqp->position, iqp->position_len, undefined);
759
760 if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
761 cf_strcpy (iqp->access, iqp->access_len, undefined);
762
763 if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
764 {
765 p = inquire_read (iqp->file, iqp->file_len);
766 cf_strcpy (iqp->read, iqp->read_len, p);
767 }
768
769 if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
770 {
771 p = inquire_write (iqp->file, iqp->file_len);
772 cf_strcpy (iqp->write, iqp->write_len, p);
773 }
774
775 if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
776 {
777 p = inquire_read (iqp->file, iqp->file_len);
778 cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
779 }
780 }
781
782
783 /* Library entry point for the INQUIRE statement (non-IOLENGTH
784 form). */
785
786 extern void st_inquire (st_parameter_inquire *);
787 export_proto(st_inquire);
788
789 void
st_inquire(st_parameter_inquire * iqp)790 st_inquire (st_parameter_inquire *iqp)
791 {
792 gfc_unit *u;
793
794 library_start (&iqp->common);
795
796 if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0)
797 {
798 u = find_unit (iqp->common.unit);
799 inquire_via_unit (iqp, u);
800 }
801 else
802 {
803 u = find_file (iqp->file, iqp->file_len);
804 if (u == NULL)
805 inquire_via_filename (iqp);
806 else
807 inquire_via_unit (iqp, u);
808 }
809 if (u != NULL)
810 unlock_unit (u);
811
812 library_end ();
813 }
814