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