l4/pkg/libgfortran/lib/contrib/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             {
 413               sflush (u->s);
 414               *iqp->size = ssize (u->s);
 415             }
 416         }
 417     }
 418
 419   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
 420     {
 421       if (u == NULL || u->flags.access == ACCESS_DIRECT)
 422         p = undefined;
 423       else
 424         {
 425           /* If the position is unspecified, check if we can figure
 426              out whether it's at the beginning or end.  */
 427           if (u->flags.position == POSITION_UNSPECIFIED)
 428             {
 429               gfc_offset cur = stell (u->s);
 430               if (cur == 0)
 431                 u->flags.position = POSITION_REWIND;
 432               else if (cur != -1 && (ssize (u->s) == cur))
 433                 u->flags.position = POSITION_APPEND;
 434             }
 435           switch (u->flags.position)
 436             {
 437             case POSITION_REWIND:
 438               p = "REWIND";
 439               break;
 440             case POSITION_APPEND:
 441               p = "APPEND";
 442               break;
 443             case POSITION_ASIS:
 444               p = "ASIS";
 445               break;
 446             default:
 447               /* If the position has changed and is not rewind or
 448                  append, it must be set to a processor-dependent
 449                  value.  */
 450               p = "UNSPECIFIED";
 451               break;
 452             }
 453         }
 454       cf_strcpy (iqp->position, iqp->position_len, p);
 455     }
 456
 457   if ((cf & IOPARM_INQUIRE_HAS_ACTION) != 0)
 458     {
 459       if (u == NULL)
 460         p = undefined;
 461       else
 462         switch (u->flags.action)
 463           {
 464           case ACTION_READ:
 465             p = "READ";
 466             break;
 467           case ACTION_WRITE:
 468             p = "WRITE";
 469             break;
 470           case ACTION_READWRITE:
 471             p = "READWRITE";
 472             break;
 473           default:
 474             internal_error (&iqp->common, "inquire_via_unit(): Bad action");
 475           }
 476
 477       cf_strcpy (iqp->action, iqp->action_len, p);
 478     }
 479
 480   if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
 481     {
 482       p = (u == NULL) ? inquire_read (NULL, 0) :
 483         inquire_read (u->file, u->file_len);
 484
 485       cf_strcpy (iqp->read, iqp->read_len, p);
 486     }
 487
 488   if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
 489     {
 490       p = (u == NULL) ? inquire_write (NULL, 0) :
 491         inquire_write (u->file, u->file_len);
 492
 493       cf_strcpy (iqp->write, iqp->write_len, p);
 494     }
 495
 496   if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
 497     {
 498       p = (u == NULL) ? inquire_readwrite (NULL, 0) :
 499         inquire_readwrite (u->file, u->file_len);
 500
 501       cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
 502     }
 503
 504   if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0)
 505     {
 506       if (u == NULL || u->flags.form != FORM_FORMATTED)
 507         p = undefined;
 508       else
 509         switch (u->flags.delim)
 510           {
 511           case DELIM_NONE:
 512             p = "NONE";
 513             break;
 514           case DELIM_QUOTE:
 515             p = "QUOTE";
 516             break;
 517           case DELIM_APOSTROPHE:
 518             p = "APOSTROPHE";
 519             break;
 520           default:
 521             internal_error (&iqp->common, "inquire_via_unit(): Bad delim");
 522           }
 523
 524       cf_strcpy (iqp->delim, iqp->delim_len, p);
 525     }
 526
 527   if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
 528     {
 529       if (u == NULL || u->flags.form != FORM_FORMATTED)
 530         p = undefined;
 531       else
 532         switch (u->flags.pad)
 533           {
 534           case PAD_NO:
 535             p = "NO";
 536             break;
 537           case PAD_YES:
 538             p = "YES";
 539             break;
 540           default:
 541             internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
 542           }
 543
 544       cf_strcpy (iqp->pad, iqp->pad_len, p);
 545     }
 546
 547   if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0)
 548     {
 549       if (u == NULL)
 550         p = undefined;
 551       else
 552         switch (u->flags.convert)
 553           {
 554             /*  big_endian is 0 for little-endian, 1 for big-endian.  */
 555           case GFC_CONVERT_NATIVE:
 556             p = big_endian ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
 557             break;
 558
 559           case GFC_CONVERT_SWAP:
 560             p = big_endian ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
 561             break;
 562
 563           default:
 564             internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
 565           }
 566
 567       cf_strcpy (iqp->convert, iqp->convert_len, p);
 568     }
 569 }
 570
 571
 572 /* inquire_via_filename()-- Inquiry via filename.  This subroutine is
 573  * only used if the filename is *not* connected to a unit number. */
 574
 575 static void
 576 inquire_via_filename (st_parameter_inquire *iqp)
 577 {
 578   const char *p;
 579   GFC_INTEGER_4 cf = iqp->common.flags;
 580
 581   if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
 582     *iqp->exist = file_exists (iqp->file, iqp->file_len);
 583
 584   if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
 585     *iqp->opened = 0;
 586
 587   if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
 588     *iqp->number = -1;
 589
 590   if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
 591     *iqp->named = 1;
 592
 593   if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0)
 594     fstrcpy (iqp->name, iqp->name_len, iqp->file, iqp->file_len);
 595
 596   if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
 597     cf_strcpy (iqp->access, iqp->access_len, undefined);
 598
 599   if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
 600     {
 601       p = "UNKNOWN";
 602       cf_strcpy (iqp->sequential, iqp->sequential_len, p);
 603     }
 604
 605   if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
 606     {
 607       p = "UNKNOWN";
 608       cf_strcpy (iqp->direct, iqp->direct_len, p);
 609     }
 610
 611   if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
 612     cf_strcpy (iqp->form, iqp->form_len, undefined);
 613
 614   if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
 615     {
 616       p = "UNKNOWN";
 617       cf_strcpy (iqp->formatted, iqp->formatted_len, p);
 618     }
 619
 620   if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
 621     {
 622       p = "UNKNOWN";
 623       cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
 624     }
 625
 626   if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
 627     *iqp->recl_out = 0;
 628
 629   if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
 630     *iqp->nextrec = 0;
 631
 632   if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
 633     cf_strcpy (iqp->blank, iqp->blank_len, undefined);
 634
 635   if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
 636     cf_strcpy (iqp->pad, iqp->pad_len, undefined);
 637
 638   if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
 639     {
 640       GFC_INTEGER_4 cf2 = iqp->flags2;
 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_DELIM) != 0)
 646         cf_strcpy (iqp->delim, iqp->delim_len, undefined);
 647
 648       if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
 649         cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);
 650
 651       if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
 652         cf_strcpy (iqp->delim, iqp->delim_len, undefined);
 653
 654       if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
 655         cf_strcpy (iqp->pad, iqp->pad_len, undefined);
 656
 657       if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
 658         cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
 659
 660       if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
 661         *iqp->size = file_size (iqp->file, iqp->file_len);
 662     }
 663
 664   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
 665     cf_strcpy (iqp->position, iqp->position_len, undefined);
 666
 667   if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
 668     cf_strcpy (iqp->access, iqp->access_len, undefined);
 669
 670   if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
 671     {
 672       p = inquire_read (iqp->file, iqp->file_len);
 673       cf_strcpy (iqp->read, iqp->read_len, p);
 674     }
 675
 676   if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
 677     {
 678       p = inquire_write (iqp->file, iqp->file_len);
 679       cf_strcpy (iqp->write, iqp->write_len, p);
 680     }
 681
 682   if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
 683     {
 684       p = inquire_read (iqp->file, iqp->file_len);
 685       cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
 686     }
 687 }
 688
 689
 690 /* Library entry point for the INQUIRE statement (non-IOLENGTH
 691    form).  */
 692
 693 extern void st_inquire (st_parameter_inquire *);
 694 export_proto(st_inquire);
 695
 696 void
 697 st_inquire (st_parameter_inquire *iqp)
 698 {
 699   gfc_unit *u;
 700
 701   library_start (&iqp->common);
 702
 703   if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0)
 704     {
 705       u = find_unit (iqp->common.unit);
 706       inquire_via_unit (iqp, u);
 707     }
 708   else
 709     {
 710       u = find_file (iqp->file, iqp->file_len);
 711       if (u == NULL)
 712         inquire_via_filename (iqp);
 713       else
 714         inquire_via_unit (iqp, u);
 715     }
 716   if (u != NULL)
 717     unlock_unit (u);
 718
 719   library_end ();
 720 }