Home | History | Annotate | Line # | Download | only in io
inquire.c revision 1.1 
      1 /* Copyright (C) 2002-2019 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
     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
    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     *iqp->recl_out = 0;
    710 
    711   if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
    712     *iqp->nextrec = 0;
    713 
    714   if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
    715     cf_strcpy (iqp->blank, iqp->blank_len, undefined);
    716 
    717   if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
    718     cf_strcpy (iqp->pad, iqp->pad_len, undefined);
    719 
    720   if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
    721     {
    722       GFC_INTEGER_4 cf2 = iqp->flags2;
    723 
    724       if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
    725 	cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
    726 
    727       if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
    728 	cf_strcpy (iqp->delim, iqp->delim_len, undefined);
    729 
    730       if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
    731 	cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);
    732 
    733       if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
    734 	cf_strcpy (iqp->delim, iqp->delim_len, undefined);
    735 
    736       if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
    737 	cf_strcpy (iqp->pad, iqp->pad_len, undefined);
    738 
    739       if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
    740 	cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
    741 
    742       if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
    743 	*iqp->size = file_size (iqp->file, iqp->file_len);
    744 
    745       if ((cf2 & IOPARM_INQUIRE_HAS_IQSTREAM) != 0)
    746 	cf_strcpy (iqp->iqstream, iqp->iqstream_len, "UNKNOWN");
    747 
    748       if ((cf2 & IOPARM_INQUIRE_HAS_SHARE) != 0)
    749 	cf_strcpy (iqp->share, iqp->share_len, "UNKNOWN");
    750 
    751       if ((cf2 & IOPARM_INQUIRE_HAS_CC) != 0)
    752 	cf_strcpy (iqp->cc, iqp->cc_len, "UNKNOWN");
    753     }
    754 
    755   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
    756     cf_strcpy (iqp->position, iqp->position_len, undefined);
    757 
    758   if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
    759     cf_strcpy (iqp->access, iqp->access_len, undefined);
    760 
    761   if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
    762     {
    763       p = inquire_read (iqp->file, iqp->file_len);
    764       cf_strcpy (iqp->read, iqp->read_len, p);
    765     }
    766 
    767   if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
    768     {
    769       p = inquire_write (iqp->file, iqp->file_len);
    770       cf_strcpy (iqp->write, iqp->write_len, p);
    771     }
    772 
    773   if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
    774     {
    775       p = inquire_read (iqp->file, iqp->file_len);
    776       cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
    777     }
    778 }
    779 
    780 
    781 /* Library entry point for the INQUIRE statement (non-IOLENGTH
    782    form).  */
    783 
    784 extern void st_inquire (st_parameter_inquire *);
    785 export_proto(st_inquire);
    786 
    787 void
    788 st_inquire (st_parameter_inquire *iqp)
    789 {
    790   gfc_unit *u;
    791 
    792   library_start (&iqp->common);
    793 
    794   if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0)
    795     {
    796       u = find_unit (iqp->common.unit);
    797       inquire_via_unit (iqp, u);
    798     }
    799   else
    800     {
    801       u = find_file (iqp->file, iqp->file_len);
    802       if (u == NULL)
    803 	inquire_via_filename (iqp);
    804       else
    805 	inquire_via_unit (iqp, u);
    806     }
    807   if (u != NULL)
    808     unlock_unit (u);
    809 
    810   library_end ();
    811 }
    812