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