libgfortran/io/inquire.c

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