libgfortran/io/inquire.c

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