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       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             /*  big_endian is 0 for little-endian, 1 for big-endian.  */
 616           case GFC_CONVERT_NATIVE:
 617             p = big_endian ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
 618             break;
 619
 620           case GFC_CONVERT_SWAP:
 621             p = big_endian ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
 622             break;
 623
 624           default:
 625             internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
 626           }
 627
 628       cf_strcpy (iqp->convert, iqp->convert_len, p);
 629     }
 630 }
 631
 632
 633 /* inquire_via_filename()-- Inquiry via filename.  This subroutine is
 634  * only used if the filename is *not* connected to a unit number. */
 635
 636 static void
 637 inquire_via_filename (st_parameter_inquire *iqp)
 638 {
 639   const char *p;
 640   GFC_INTEGER_4 cf = iqp->common.flags;
 641
 642   if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
 643     *iqp->exist = file_exists (iqp->file, iqp->file_len);
 644
 645   if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
 646     *iqp->opened = 0;
 647
 648   if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
 649     *iqp->number = -1;
 650
 651   if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
 652     *iqp->named = 1;
 653
 654   if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0)
 655     fstrcpy (iqp->name, iqp->name_len, iqp->file, iqp->file_len);
 656
 657   if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
 658     cf_strcpy (iqp->access, iqp->access_len, undefined);
 659
 660   if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
 661     {
 662       p = "UNKNOWN";
 663       cf_strcpy (iqp->sequential, iqp->sequential_len, p);
 664     }
 665
 666   if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
 667     {
 668       p = "UNKNOWN";
 669       cf_strcpy (iqp->direct, iqp->direct_len, p);
 670     }
 671
 672   if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
 673     cf_strcpy (iqp->form, iqp->form_len, undefined);
 674
 675   if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
 676     {
 677       p = "UNKNOWN";
 678       cf_strcpy (iqp->formatted, iqp->formatted_len, p);
 679     }
 680
 681   if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
 682     {
 683       p = "UNKNOWN";
 684       cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
 685     }
 686
 687   if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
 688     *iqp->recl_out = 0;
 689
 690   if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
 691     *iqp->nextrec = 0;
 692
 693   if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
 694     cf_strcpy (iqp->blank, iqp->blank_len, undefined);
 695
 696   if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
 697     cf_strcpy (iqp->pad, iqp->pad_len, undefined);
 698
 699   if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
 700     {
 701       GFC_INTEGER_4 cf2 = iqp->flags2;
 702
 703       if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
 704         cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
 705
 706       if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
 707         cf_strcpy (iqp->delim, iqp->delim_len, undefined);
 708
 709       if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
 710         cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);
 711
 712       if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
 713         cf_strcpy (iqp->delim, iqp->delim_len, undefined);
 714
 715       if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
 716         cf_strcpy (iqp->pad, iqp->pad_len, undefined);
 717
 718       if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
 719         cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
 720
 721       if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
 722         *iqp->size = file_size (iqp->file, iqp->file_len);
 723
 724       if ((cf2 & IOPARM_INQUIRE_HAS_IQSTREAM) != 0)
 725         cf_strcpy (iqp->iqstream, iqp->iqstream_len, "UNKNOWN");
 726
 727       if ((cf2 & IOPARM_INQUIRE_HAS_SHARE) != 0)
 728         cf_strcpy (iqp->share, iqp->share_len, "UNKNOWN");
 729
 730       if ((cf2 & IOPARM_INQUIRE_HAS_CC) != 0)
 731         cf_strcpy (iqp->cc, iqp->cc_len, "UNKNOWN");
 732     }
 733
 734   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
 735     cf_strcpy (iqp->position, iqp->position_len, undefined);
 736
 737   if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
 738     cf_strcpy (iqp->access, iqp->access_len, undefined);
 739
 740   if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
 741     {
 742       p = inquire_read (iqp->file, iqp->file_len);
 743       cf_strcpy (iqp->read, iqp->read_len, p);
 744     }
 745
 746   if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
 747     {
 748       p = inquire_write (iqp->file, iqp->file_len);
 749       cf_strcpy (iqp->write, iqp->write_len, p);
 750     }
 751
 752   if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
 753     {
 754       p = inquire_read (iqp->file, iqp->file_len);
 755       cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
 756     }
 757 }
 758
 759
 760 /* Library entry point for the INQUIRE statement (non-IOLENGTH
 761    form).  */
 762
 763 extern void st_inquire (st_parameter_inquire *);
 764 export_proto(st_inquire);
 765
 766 void
 767 st_inquire (st_parameter_inquire *iqp)
 768 {
 769   gfc_unit *u;
 770
 771   library_start (&iqp->common);
 772
 773   if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0)
 774     {
 775       u = find_unit (iqp->common.unit);
 776       inquire_via_unit (iqp, u);
 777     }
 778   else
 779     {
 780       u = find_file (iqp->file, iqp->file_len);
 781       if (u == NULL)
 782         inquire_via_filename (iqp);
 783       else
 784         inquire_via_unit (iqp, u);
 785     }
 786   if (u != NULL)
 787     unlock_unit (u);
 788
 789   library_end ();
 790 }