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