1/* Copyright (C) 2002-2020 Free Software Foundation, Inc.
2   Contributed by Andy Vaught
3
4This file is part of the GNU Fortran runtime library (libgfortran).
5
6Libgfortran is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 3, or (at your option)
9any later version.
10
11Libgfortran is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14GNU General Public License for more details.
15
16Under Section 7 of GPL version 3, you are granted additional
17permissions described in the GCC Runtime Library Exception, version
183.1, as published by the Free Software Foundation.
19
20You should have received a copy of the GNU General Public License and
21a copy of the GCC Runtime Library Exception along with this program;
22see 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
34static const char yes[] = "YES", no[] = "NO", undefined[] = "UNDEFINED";
35
36
37/* inquire_via_unit()-- Inquiry via unit number.  The unit might not exist. */
38
39static void
40inquire_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
657static void
658inquire_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
786extern void st_inquire (st_parameter_inquire *);
787export_proto(st_inquire);
788
789void
790st_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