1 /* Copyright (C) 2002-2021 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