libgfortran/io/inquire.c

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