inquire.c

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