libgfortran/io/inquire.c

   1 /* Copyright (C) 2002, 2003, 2005, 2007, 2009, 2010
   2    Free Software Foundation, Inc.
   3    Contributed by Andy Vaught
   4
   5 This file is part of the GNU Fortran 95 runtime library (libgfortran).
   6
   7 Libgfortran is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 3, or (at your option)
  10 any later version.
  11
  12 Libgfortran is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 Under Section 7 of GPL version 3, you are granted additional
  18 permissions described in the GCC Runtime Library Exception, version
  19 3.1, as published by the Free Software Foundation.
  20
  21 You should have received a copy of the GNU General Public License and
  22 a copy of the GCC Runtime Library Exception along with this program;
  23 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  24 <http://www.gnu.org/licenses/>.  */
  25
  26
  27 /* Implement the non-IOLENGTH variant of the INQUIRY statement */
  28
  29 #include "io.h"
  30 #include "unix.h"
  31 #include <string.h>
  32
  33
  34 static const char 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 ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
  46     {
  47       *iqp->exist = (iqp->common.unit >= 0
  48                      && iqp->common.unit <= GFC_INTEGER_4_HUGE);
  49
  50       if ((cf & IOPARM_INQUIRE_HAS_FILE) == 0)
  51         {
  52           if (!(*iqp->exist))
  53             *iqp->common.iostat = LIBERROR_BAD_UNIT;
  54           *iqp->exist = *iqp->exist
  55                         && (*iqp->common.iostat != LIBERROR_BAD_UNIT);
  56         }
  57     }
  58
  59   if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
  60     *iqp->opened = (u != NULL);
  61
  62   if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
  63     *iqp->number = (u != NULL) ? u->unit_number : -1;
  64
  65   if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
  66     *iqp->named = (u != NULL && u->flags.status != STATUS_SCRATCH);
  67
  68   if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0
  69       && u != NULL && u->flags.status != STATUS_SCRATCH)
  70     {
  71 #ifdef HAVE_TTYNAME
  72       if (u->unit_number == options.stdin_unit
  73           || u->unit_number == options.stdout_unit
  74           || u->unit_number == options.stderr_unit)
  75         {
  76           char * tmp = stream_ttyname (u->s);
  77           if (tmp != NULL)
  78             {
  79               int tmplen = strlen (tmp);
  80               fstrcpy (iqp->name, iqp->name_len, tmp, tmplen);
  81             }
  82           else /* If ttyname does not work, go with the default.  */
  83             fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
  84         }
  85       else
  86         fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
  87 #elif defined __MINGW32__
  88       if (u->unit_number == options.stdin_unit)
  89         fstrcpy (iqp->name, iqp->name_len, "CONIN$", sizeof("CONIN$"));
  90       else if (u->unit_number == options.stdout_unit)
  91         fstrcpy (iqp->name, iqp->name_len, "CONOUT$", sizeof("CONOUT$"));
  92       else if (u->unit_number == options.stderr_unit)
  93         fstrcpy (iqp->name, iqp->name_len, "CONERR$", sizeof("CONERR$"));
  94       else
  95         fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
  96 #else
  97     fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
  98 #endif
  99     }
 100
 101   if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
 102     {
 103       if (u == NULL)
 104         p = undefined;
 105       else
 106         switch (u->flags.access)
 107           {
 108           case ACCESS_SEQUENTIAL:
 109             p = "SEQUENTIAL";
 110             break;
 111           case ACCESS_DIRECT:
 112             p = "DIRECT";
 113             break;
 114           case ACCESS_STREAM:
 115             p = "STREAM";
 116             break;
 117           default:
 118             internal_error (&iqp->common, "inquire_via_unit(): Bad access");
 119           }
 120
 121       cf_strcpy (iqp->access, iqp->access_len, p);
 122     }
 123
 124   if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
 125     {
 126       if (u == NULL)
 127         p = inquire_sequential (NULL, 0);
 128       else
 129         switch (u->flags.access)
 130           {
 131           case ACCESS_DIRECT:
 132           case ACCESS_STREAM:
 133             p = "NO";
 134             break;
 135           case ACCESS_SEQUENTIAL:
 136             p = "YES";
 137             break;
 138           default:
 139             internal_error (&iqp->common, "inquire_via_unit(): Bad access");
 140           }
 141
 142       cf_strcpy (iqp->sequential, iqp->sequential_len, p);
 143     }
 144
 145   if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
 146     {
 147       if (u == NULL)
 148         p = inquire_direct (NULL, 0);
 149       else
 150         switch (u->flags.access)
 151           {
 152           case ACCESS_SEQUENTIAL:
 153           case ACCESS_STREAM:
 154             p = "NO";
 155             break;
 156           case ACCESS_DIRECT:
 157             p = "YES";
 158             break;
 159           default:
 160             internal_error (&iqp->common, "inquire_via_unit(): Bad access");
 161           }
 162
 163       cf_strcpy (iqp->direct, iqp->direct_len, p);
 164     }
 165
 166   if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
 167     {
 168       if (u == NULL)
 169         p = undefined;
 170       else
 171         switch (u->flags.form)
 172           {
 173           case FORM_FORMATTED:
 174             p = "FORMATTED";
 175             break;
 176           case FORM_UNFORMATTED:
 177             p = "UNFORMATTED";
 178             break;
 179           default:
 180             internal_error (&iqp->common, "inquire_via_unit(): Bad form");
 181           }
 182
 183       cf_strcpy (iqp->form, iqp->form_len, p);
 184     }
 185
 186   if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
 187     {
 188       if (u == NULL)
 189         p = inquire_formatted (NULL, 0);
 190       else
 191         switch (u->flags.form)
 192           {
 193           case FORM_FORMATTED:
 194             p = "YES";
 195             break;
 196           case FORM_UNFORMATTED:
 197             p = "NO";
 198             break;
 199           default:
 200             internal_error (&iqp->common, "inquire_via_unit(): Bad form");
 201           }
 202
 203       cf_strcpy (iqp->formatted, iqp->formatted_len, p);
 204     }
 205
 206   if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
 207     {
 208       if (u == NULL)
 209         p = inquire_unformatted (NULL, 0);
 210       else
 211         switch (u->flags.form)
 212           {
 213           case FORM_FORMATTED:
 214             p = "NO";
 215             break;
 216           case FORM_UNFORMATTED:
 217             p = "YES";
 218             break;
 219           default:
 220             internal_error (&iqp->common, "inquire_via_unit(): Bad form");
 221           }
 222
 223       cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
 224     }
 225
 226   if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
 227     *iqp->recl_out = (u != NULL) ? u->recl : 0;
 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_PENDING) != 0)
 286         *iqp->pending = 0;
 287
 288       if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0)
 289         *iqp->id = 0;
 290
 291       if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
 292         {
 293           if (u == NULL || u->flags.form != FORM_FORMATTED)
 294             p = undefined;
 295           else
 296             switch (u->flags.encoding)
 297               {
 298               case ENCODING_DEFAULT:
 299                 p = "UNKNOWN";
 300                 break;
 301               case ENCODING_UTF8:
 302                 p = "UTF-8";
 303                 break;
 304               default:
 305                 internal_error (&iqp->common, "inquire_via_unit(): Bad encoding");
 306               }
 307
 308           cf_strcpy (iqp->encoding, iqp->encoding_len, p);
 309         }
 310
 311       if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
 312         {
 313           if (u == NULL || u->flags.form != FORM_FORMATTED)
 314             p = undefined;
 315           else
 316             switch (u->flags.decimal)
 317               {
 318               case DECIMAL_POINT:
 319                 p = "POINT";
 320                 break;
 321               case DECIMAL_COMMA:
 322                 p = "COMMA";
 323                 break;
 324               default:
 325                 internal_error (&iqp->common, "inquire_via_unit(): Bad comma");
 326               }
 327
 328           cf_strcpy (iqp->decimal, iqp->decimal_len, p);
 329         }
 330
 331       if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0)
 332         {
 333           if (u == NULL)
 334             p = undefined;
 335           else
 336             switch (u->flags.async)
 337             {
 338               case ASYNC_YES:
 339                 p = "YES";
 340                 break;
 341               case ASYNC_NO:
 342                 p = "NO";
 343                 break;
 344               default:
 345                 internal_error (&iqp->common, "inquire_via_unit(): Bad async");
 346             }
 347
 348           cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p);
 349         }
 350
 351       if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0)
 352         {
 353           if (u == NULL)
 354             p = undefined;
 355           else
 356             switch (u->flags.sign)
 357             {
 358               case SIGN_PROCDEFINED:
 359                 p = "PROCESSOR_DEFINED";
 360                 break;
 361               case SIGN_SUPPRESS:
 362                 p = "SUPPRESS";
 363                 break;
 364               case SIGN_PLUS:
 365                 p = "PLUS";
 366                 break;
 367               default:
 368                 internal_error (&iqp->common, "inquire_via_unit(): Bad sign");
 369             }
 370
 371           cf_strcpy (iqp->sign, iqp->sign_len, p);
 372         }
 373
 374       if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0)
 375         {
 376           if (u == NULL)
 377             p = undefined;
 378           else
 379             switch (u->flags.round)
 380             {
 381               case ROUND_UP:
 382                 p = "UP";
 383                 break;
 384               case ROUND_DOWN:
 385                 p = "DOWN";
 386                 break;
 387               case ROUND_ZERO:
 388                 p = "ZERO";
 389                 break;
 390               case ROUND_NEAREST:
 391                 p = "NEAREST";
 392                 break;
 393               case ROUND_COMPATIBLE:
 394                 p = "COMPATIBLE";
 395                 break;
 396               case ROUND_PROCDEFINED:
 397                 p = "PROCESSOR_DEFINED";
 398                 break;
 399               default:
 400                 internal_error (&iqp->common, "inquire_via_unit(): Bad round");
 401             }
 402
 403           cf_strcpy (iqp->round, iqp->round_len, p);
 404         }
 405
 406       if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
 407         {
 408           if (u == NULL)
 409             *iqp->size = -1;
 410           else
 411             *iqp->size = file_size (u->file, (gfc_charlen_type) u->file_len);
 412         }
 413     }
 414
 415   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
 416     {
 417       if (u == NULL || u->flags.access == ACCESS_DIRECT)
 418         p = undefined;
 419       else
 420         switch (u->flags.position)
 421           {
 422              case POSITION_REWIND:
 423                p = "REWIND";
 424                break;
 425              case POSITION_APPEND:
 426                p = "APPEND";
 427                break;
 428              case POSITION_ASIS:
 429                p = "ASIS";
 430                break;
 431              default:
 432                /* if not direct access, it must be
 433                   either REWIND, APPEND, or ASIS.
 434                   ASIS seems to be the best default */
 435                p = "ASIS";
 436                break;
 437           }
 438       cf_strcpy (iqp->position, iqp->position_len, p);
 439     }
 440
 441   if ((cf & IOPARM_INQUIRE_HAS_ACTION) != 0)
 442     {
 443       if (u == NULL)
 444         p = undefined;
 445       else
 446         switch (u->flags.action)
 447           {
 448           case ACTION_READ:
 449             p = "READ";
 450             break;
 451           case ACTION_WRITE:
 452             p = "WRITE";
 453             break;
 454           case ACTION_READWRITE:
 455             p = "READWRITE";
 456             break;
 457           default:
 458             internal_error (&iqp->common, "inquire_via_unit(): Bad action");
 459           }
 460
 461       cf_strcpy (iqp->action, iqp->action_len, p);
 462     }
 463
 464   if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
 465     {
 466       p = (u == NULL) ? inquire_read (NULL, 0) :
 467         inquire_read (u->file, u->file_len);
 468
 469       cf_strcpy (iqp->read, iqp->read_len, p);
 470     }
 471
 472   if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
 473     {
 474       p = (u == NULL) ? inquire_write (NULL, 0) :
 475         inquire_write (u->file, u->file_len);
 476
 477       cf_strcpy (iqp->write, iqp->write_len, p);
 478     }
 479
 480   if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
 481     {
 482       p = (u == NULL) ? inquire_readwrite (NULL, 0) :
 483         inquire_readwrite (u->file, u->file_len);
 484
 485       cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
 486     }
 487
 488   if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0)
 489     {
 490       if (u == NULL || u->flags.form != FORM_FORMATTED)
 491         p = undefined;
 492       else
 493         switch (u->flags.delim)
 494           {
 495           case DELIM_NONE:
 496             p = "NONE";
 497             break;
 498           case DELIM_QUOTE:
 499             p = "QUOTE";
 500             break;
 501           case DELIM_APOSTROPHE:
 502             p = "APOSTROPHE";
 503             break;
 504           default:
 505             internal_error (&iqp->common, "inquire_via_unit(): Bad delim");
 506           }
 507
 508       cf_strcpy (iqp->delim, iqp->delim_len, p);
 509     }
 510
 511   if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
 512     {
 513       if (u == NULL || u->flags.form != FORM_FORMATTED)
 514         p = undefined;
 515       else
 516         switch (u->flags.pad)
 517           {
 518           case PAD_NO:
 519             p = "NO";
 520             break;
 521           case PAD_YES:
 522             p = "YES";
 523             break;
 524           default:
 525             internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
 526           }
 527
 528       cf_strcpy (iqp->pad, iqp->pad_len, p);
 529     }
 530
 531   if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0)
 532     {
 533       if (u == NULL)
 534         p = undefined;
 535       else
 536         switch (u->flags.convert)
 537           {
 538             /*  big_endian is 0 for little-endian, 1 for big-endian.  */
 539           case GFC_CONVERT_NATIVE:
 540             p = big_endian ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
 541             break;
 542
 543           case GFC_CONVERT_SWAP:
 544             p = big_endian ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
 545             break;
 546
 547           default:
 548             internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
 549           }
 550
 551       cf_strcpy (iqp->convert, iqp->convert_len, p);
 552     }
 553 }
 554
 555
 556 /* inquire_via_filename()-- Inquiry via filename.  This subroutine is
 557  * only used if the filename is *not* connected to a unit number. */
 558
 559 static void
 560 inquire_via_filename (st_parameter_inquire *iqp)
 561 {
 562   const char *p;
 563   GFC_INTEGER_4 cf = iqp->common.flags;
 564
 565   if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
 566     *iqp->exist = file_exists (iqp->file, iqp->file_len);
 567
 568   if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
 569     *iqp->opened = 0;
 570
 571   if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
 572     *iqp->number = -1;
 573
 574   if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
 575     *iqp->named = 1;
 576
 577   if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0)
 578     fstrcpy (iqp->name, iqp->name_len, iqp->file, iqp->file_len);
 579
 580   if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
 581     cf_strcpy (iqp->access, iqp->access_len, undefined);
 582
 583   if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
 584     {
 585       p = "UNKNOWN";
 586       cf_strcpy (iqp->sequential, iqp->sequential_len, p);
 587     }
 588
 589   if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
 590     {
 591       p = "UNKNOWN";
 592       cf_strcpy (iqp->direct, iqp->direct_len, p);
 593     }
 594
 595   if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
 596     cf_strcpy (iqp->form, iqp->form_len, undefined);
 597
 598   if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
 599     {
 600       p = "UNKNOWN";
 601       cf_strcpy (iqp->formatted, iqp->formatted_len, p);
 602     }
 603
 604   if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
 605     {
 606       p = "UNKNOWN";
 607       cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
 608     }
 609
 610   if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
 611     *iqp->recl_out = 0;
 612
 613   if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
 614     *iqp->nextrec = 0;
 615
 616   if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
 617     cf_strcpy (iqp->blank, iqp->blank_len, undefined);
 618
 619   if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
 620     cf_strcpy (iqp->pad, iqp->pad_len, undefined);
 621
 622   if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
 623     {
 624       GFC_INTEGER_4 cf2 = iqp->flags2;
 625
 626       if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
 627         cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
 628
 629       if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
 630         cf_strcpy (iqp->delim, iqp->delim_len, undefined);
 631
 632       if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
 633         cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);
 634
 635       if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
 636         cf_strcpy (iqp->delim, iqp->delim_len, undefined);
 637
 638       if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
 639         cf_strcpy (iqp->pad, iqp->pad_len, undefined);
 640
 641       if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
 642         cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
 643
 644       if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
 645         *iqp->size = file_size (iqp->file, iqp->file_len);
 646     }
 647
 648   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
 649     cf_strcpy (iqp->position, iqp->position_len, undefined);
 650
 651   if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
 652     cf_strcpy (iqp->access, iqp->access_len, undefined);
 653
 654   if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
 655     {
 656       p = inquire_read (iqp->file, iqp->file_len);
 657       cf_strcpy (iqp->read, iqp->read_len, p);
 658     }
 659
 660   if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
 661     {
 662       p = inquire_write (iqp->file, iqp->file_len);
 663       cf_strcpy (iqp->write, iqp->write_len, p);
 664     }
 665
 666   if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
 667     {
 668       p = inquire_read (iqp->file, iqp->file_len);
 669       cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
 670     }
 671 }
 672
 673
 674 /* Library entry point for the INQUIRE statement (non-IOLENGTH
 675    form).  */
 676
 677 extern void st_inquire (st_parameter_inquire *);
 678 export_proto(st_inquire);
 679
 680 void
 681 st_inquire (st_parameter_inquire *iqp)
 682 {
 683   gfc_unit *u;
 684
 685   library_start (&iqp->common);
 686
 687   if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0)
 688     {
 689       u = find_unit (iqp->common.unit);
 690       inquire_via_unit (iqp, u);
 691     }
 692   else
 693     {
 694       u = find_file (iqp->file, iqp->file_len);
 695       if (u == NULL)
 696         inquire_via_filename (iqp);
 697       else
 698         inquire_via_unit (iqp, u);
 699     }
 700   if (u != NULL)
 701     unlock_unit (u);
 702
 703   library_end ();
 704 }