libgfortran/io/inquire.c

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