libgfortran/io/inquire.c

   1 /* Copyright (C) 2002-2017 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       if ((cf2 & IOPARM_INQUIRE_HAS_SHARE) != 0)
 433         {
 434           if (u == NULL)
 435             p = "UNKNOWN";
 436           else
 437             switch (u->flags.share)
 438               {
 439                 case SHARE_DENYRW:
 440                   p = "DENYRW";
 441                   break;
 442                 case SHARE_DENYNONE:
 443                   p = "DENYNONE";
 444                   break;
 445                 case SHARE_UNSPECIFIED:
 446                   p = "NODENY";
 447                   break;
 448                 default:
 449                   internal_error (&iqp->common,
 450                       "inquire_via_unit(): Bad share");
 451                   break;
 452               }
 453
 454           cf_strcpy (iqp->share, iqp->share_len, p);
 455         }
 456
 457       if ((cf2 & IOPARM_INQUIRE_HAS_CC) != 0)
 458         {
 459           if (u == NULL)
 460             p = "UNKNOWN";
 461           else
 462             switch (u->flags.cc)
 463               {
 464                 case CC_FORTRAN:
 465                   p = "FORTRAN";
 466                   break;
 467                 case CC_LIST:
 468                   p = "LIST";
 469                   break;
 470                 case CC_NONE:
 471                   p = "NONE";
 472                   break;
 473                 case CC_UNSPECIFIED:
 474                   p = "UNKNOWN";
 475                   break;
 476                 default:
 477                   internal_error (&iqp->common, "inquire_via_unit(): Bad cc");
 478                   break;
 479               }
 480
 481           cf_strcpy (iqp->cc, iqp->cc_len, p);
 482         }
 483     }
 484
 485   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
 486     {
 487       if (u == NULL || u->flags.access == ACCESS_DIRECT)
 488         p = undefined;
 489       else
 490         {
 491           /* If the position is unspecified, check if we can figure
 492              out whether it's at the beginning or end.  */
 493           if (u->flags.position == POSITION_UNSPECIFIED)
 494             {
 495               gfc_offset cur = stell (u->s);
 496               if (cur == 0)
 497                 u->flags.position = POSITION_REWIND;
 498               else if (cur != -1 && (ssize (u->s) == cur))
 499                 u->flags.position = POSITION_APPEND;
 500             }
 501           switch (u->flags.position)
 502             {
 503             case POSITION_REWIND:
 504               p = "REWIND";
 505               break;
 506             case POSITION_APPEND:
 507               p = "APPEND";
 508               break;
 509             case POSITION_ASIS:
 510               p = "ASIS";
 511               break;
 512             default:
 513               /* If the position has changed and is not rewind or
 514                  append, it must be set to a processor-dependent
 515                  value.  */
 516               p = "UNSPECIFIED";
 517               break;
 518             }
 519         }
 520       cf_strcpy (iqp->position, iqp->position_len, p);
 521     }
 522
 523   if ((cf & IOPARM_INQUIRE_HAS_ACTION) != 0)
 524     {
 525       if (u == NULL)
 526         p = undefined;
 527       else
 528         switch (u->flags.action)
 529           {
 530           case ACTION_READ:
 531             p = "READ";
 532             break;
 533           case ACTION_WRITE:
 534             p = "WRITE";
 535             break;
 536           case ACTION_READWRITE:
 537             p = "READWRITE";
 538             break;
 539           default:
 540             internal_error (&iqp->common, "inquire_via_unit(): Bad action");
 541           }
 542
 543       cf_strcpy (iqp->action, iqp->action_len, p);
 544     }
 545
 546   if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
 547     {
 548       p = (!u || u->flags.action == ACTION_WRITE) ? no : yes;
 549       cf_strcpy (iqp->read, iqp->read_len, p);
 550     }
 551
 552   if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
 553     {
 554       p = (!u || u->flags.action == ACTION_READ) ? no : yes;
 555       cf_strcpy (iqp->write, iqp->write_len, p);
 556     }
 557
 558   if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
 559     {
 560       p = (!u || u->flags.action != ACTION_READWRITE) ? no : yes;
 561       cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
 562     }
 563
 564   if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0)
 565     {
 566       if (u == NULL || u->flags.form != FORM_FORMATTED)
 567         p = undefined;
 568       else
 569         switch (u->flags.delim)
 570           {
 571           case DELIM_NONE:
 572           case DELIM_UNSPECIFIED:
 573             p = "NONE";
 574             break;
 575           case DELIM_QUOTE:
 576             p = "QUOTE";
 577             break;
 578           case DELIM_APOSTROPHE:
 579             p = "APOSTROPHE";
 580             break;
 581           default:
 582             internal_error (&iqp->common, "inquire_via_unit(): Bad delim");
 583           }
 584
 585       cf_strcpy (iqp->delim, iqp->delim_len, p);
 586     }
 587
 588   if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
 589     {
 590       if (u == NULL || u->flags.form != FORM_FORMATTED)
 591         p = undefined;
 592       else
 593         switch (u->flags.pad)
 594           {
 595           case PAD_NO:
 596             p = no;
 597             break;
 598           case PAD_YES:
 599             p = yes;
 600             break;
 601           default:
 602             internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
 603           }
 604
 605       cf_strcpy (iqp->pad, iqp->pad_len, p);
 606     }
 607
 608   if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0)
 609     {
 610       if (u == NULL)
 611         p = undefined;
 612       else
 613         switch (u->flags.convert)
 614           {
 615           case GFC_CONVERT_NATIVE:
 616             p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
 617             break;
 618
 619           case GFC_CONVERT_SWAP:
 620             p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
 621             break;
 622
 623           default:
 624             internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
 625           }
 626
 627       cf_strcpy (iqp->convert, iqp->convert_len, p);
 628     }
 629 }
 630
 631
 632 /* inquire_via_filename()-- Inquiry via filename.  This subroutine is
 633    only used if the filename is *not* connected to a unit number. */
 634
 635 static void
 636 inquire_via_filename (st_parameter_inquire *iqp)
 637 {
 638   const char *p;
 639   GFC_INTEGER_4 cf = iqp->common.flags;
 640
 641   if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
 642     *iqp->exist = file_exists (iqp->file, iqp->file_len);
 643
 644   if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
 645     *iqp->opened = 0;
 646
 647   if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
 648     *iqp->number = -1;
 649
 650   if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
 651     *iqp->named = 1;
 652
 653   if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0)
 654     fstrcpy (iqp->name, iqp->name_len, iqp->file, iqp->file_len);
 655
 656   if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
 657     cf_strcpy (iqp->access, iqp->access_len, undefined);
 658
 659   if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
 660     {
 661       p = "UNKNOWN";
 662       cf_strcpy (iqp->sequential, iqp->sequential_len, p);
 663     }
 664
 665   if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
 666     {
 667       p = "UNKNOWN";
 668       cf_strcpy (iqp->direct, iqp->direct_len, p);
 669     }
 670
 671   if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
 672     cf_strcpy (iqp->form, iqp->form_len, undefined);
 673
 674   if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
 675     {
 676       p = "UNKNOWN";
 677       cf_strcpy (iqp->formatted, iqp->formatted_len, p);
 678     }
 679
 680   if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
 681     {
 682       p = "UNKNOWN";
 683       cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
 684     }
 685
 686   if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
 687     *iqp->recl_out = 0;
 688
 689   if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
 690     *iqp->nextrec = 0;
 691
 692   if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
 693     cf_strcpy (iqp->blank, iqp->blank_len, undefined);
 694
 695   if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
 696     cf_strcpy (iqp->pad, iqp->pad_len, undefined);
 697
 698   if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
 699     {
 700       GFC_INTEGER_4 cf2 = iqp->flags2;
 701
 702       if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
 703         cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
 704
 705       if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
 706         cf_strcpy (iqp->delim, iqp->delim_len, undefined);
 707
 708       if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
 709         cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);
 710
 711       if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
 712         cf_strcpy (iqp->delim, iqp->delim_len, undefined);
 713
 714       if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
 715         cf_strcpy (iqp->pad, iqp->pad_len, undefined);
 716
 717       if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
 718         cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
 719
 720       if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
 721         *iqp->size = file_size (iqp->file, iqp->file_len);
 722
 723       if ((cf2 & IOPARM_INQUIRE_HAS_IQSTREAM) != 0)
 724         cf_strcpy (iqp->iqstream, iqp->iqstream_len, "UNKNOWN");
 725
 726       if ((cf2 & IOPARM_INQUIRE_HAS_SHARE) != 0)
 727         cf_strcpy (iqp->share, iqp->share_len, "UNKNOWN");
 728
 729       if ((cf2 & IOPARM_INQUIRE_HAS_CC) != 0)
 730         cf_strcpy (iqp->cc, iqp->cc_len, "UNKNOWN");
 731     }
 732
 733   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
 734     cf_strcpy (iqp->position, iqp->position_len, undefined);
 735
 736   if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
 737     cf_strcpy (iqp->access, iqp->access_len, undefined);
 738
 739   if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
 740     {
 741       p = inquire_read (iqp->file, iqp->file_len);
 742       cf_strcpy (iqp->read, iqp->read_len, p);
 743     }
 744
 745   if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
 746     {
 747       p = inquire_write (iqp->file, iqp->file_len);
 748       cf_strcpy (iqp->write, iqp->write_len, p);
 749     }
 750
 751   if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
 752     {
 753       p = inquire_read (iqp->file, iqp->file_len);
 754       cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
 755     }
 756 }
 757
 758
 759 /* Library entry point for the INQUIRE statement (non-IOLENGTH
 760    form).  */
 761
 762 extern void st_inquire (st_parameter_inquire *);
 763 export_proto(st_inquire);
 764
 765 void
 766 st_inquire (st_parameter_inquire *iqp)
 767 {
 768   gfc_unit *u;
 769
 770   library_start (&iqp->common);
 771
 772   if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0)
 773     {
 774       u = find_unit (iqp->common.unit);
 775       inquire_via_unit (iqp, u);
 776     }
 777   else
 778     {
 779       u = find_file (iqp->file, iqp->file_len);
 780       if (u == NULL)
 781         inquire_via_filename (iqp);
 782       else
 783         inquire_via_unit (iqp, u);
 784     }
 785   if (u != NULL)
 786     unlock_unit (u);
 787
 788   library_end ();
 789 }