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