libgfortran/io/inquire.c

   1 /* Copyright (C) 2002-2014 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 yes[] = "YES", no[] = "NO", 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             cf_strcpy (iqp->name, iqp->name_len, u->filename);
  84         }
  85       else
  86         cf_strcpy (iqp->name, iqp->name_len, u->filename);
  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 || u->flags.action == ACTION_WRITE) ? no : yes;
 503       cf_strcpy (iqp->read, iqp->read_len, p);
 504     }
 505
 506   if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
 507     {
 508       p = (!u || u->flags.action == ACTION_READ) ? no : yes;
 509       cf_strcpy (iqp->write, iqp->write_len, p);
 510     }
 511
 512   if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
 513     {
 514       p = (!u || u->flags.action != ACTION_READWRITE) ? no : yes;
 515       cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
 516     }
 517
 518   if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0)
 519     {
 520       if (u == NULL || u->flags.form != FORM_FORMATTED)
 521         p = undefined;
 522       else
 523         switch (u->flags.delim)
 524           {
 525           case DELIM_NONE:
 526           case DELIM_UNSPECIFIED:
 527             p = "NONE";
 528             break;
 529           case DELIM_QUOTE:
 530             p = "QUOTE";
 531             break;
 532           case DELIM_APOSTROPHE:
 533             p = "APOSTROPHE";
 534             break;
 535           default:
 536             internal_error (&iqp->common, "inquire_via_unit(): Bad delim");
 537           }
 538
 539       cf_strcpy (iqp->delim, iqp->delim_len, p);
 540     }
 541
 542   if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
 543     {
 544       if (u == NULL || u->flags.form != FORM_FORMATTED)
 545         p = undefined;
 546       else
 547         switch (u->flags.pad)
 548           {
 549           case PAD_NO:
 550             p = no;
 551             break;
 552           case PAD_YES:
 553             p = yes;
 554             break;
 555           default:
 556             internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
 557           }
 558
 559       cf_strcpy (iqp->pad, iqp->pad_len, p);
 560     }
 561
 562   if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0)
 563     {
 564       if (u == NULL)
 565         p = undefined;
 566       else
 567         switch (u->flags.convert)
 568           {
 569             /*  big_endian is 0 for little-endian, 1 for big-endian.  */
 570           case GFC_CONVERT_NATIVE:
 571             p = big_endian ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
 572             break;
 573
 574           case GFC_CONVERT_SWAP:
 575             p = big_endian ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
 576             break;
 577
 578           default:
 579             internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
 580           }
 581
 582       cf_strcpy (iqp->convert, iqp->convert_len, p);
 583     }
 584 }
 585
 586
 587 /* inquire_via_filename()-- Inquiry via filename.  This subroutine is
 588  * only used if the filename is *not* connected to a unit number. */
 589
 590 static void
 591 inquire_via_filename (st_parameter_inquire *iqp)
 592 {
 593   const char *p;
 594   GFC_INTEGER_4 cf = iqp->common.flags;
 595
 596   if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
 597     *iqp->exist = file_exists (iqp->file, iqp->file_len);
 598
 599   if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
 600     *iqp->opened = 0;
 601
 602   if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
 603     *iqp->number = -1;
 604
 605   if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
 606     *iqp->named = 1;
 607
 608   if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0)
 609     fstrcpy (iqp->name, iqp->name_len, iqp->file, iqp->file_len);
 610
 611   if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
 612     cf_strcpy (iqp->access, iqp->access_len, undefined);
 613
 614   if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
 615     {
 616       p = "UNKNOWN";
 617       cf_strcpy (iqp->sequential, iqp->sequential_len, p);
 618     }
 619
 620   if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
 621     {
 622       p = "UNKNOWN";
 623       cf_strcpy (iqp->direct, iqp->direct_len, p);
 624     }
 625
 626   if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
 627     cf_strcpy (iqp->form, iqp->form_len, undefined);
 628
 629   if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
 630     {
 631       p = "UNKNOWN";
 632       cf_strcpy (iqp->formatted, iqp->formatted_len, p);
 633     }
 634
 635   if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
 636     {
 637       p = "UNKNOWN";
 638       cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
 639     }
 640
 641   if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
 642     *iqp->recl_out = 0;
 643
 644   if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
 645     *iqp->nextrec = 0;
 646
 647   if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
 648     cf_strcpy (iqp->blank, iqp->blank_len, undefined);
 649
 650   if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
 651     cf_strcpy (iqp->pad, iqp->pad_len, undefined);
 652
 653   if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
 654     {
 655       GFC_INTEGER_4 cf2 = iqp->flags2;
 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_DELIM) != 0)
 661         cf_strcpy (iqp->delim, iqp->delim_len, undefined);
 662
 663       if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
 664         cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);
 665
 666       if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
 667         cf_strcpy (iqp->delim, iqp->delim_len, undefined);
 668
 669       if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
 670         cf_strcpy (iqp->pad, iqp->pad_len, undefined);
 671
 672       if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
 673         cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
 674
 675       if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
 676         *iqp->size = file_size (iqp->file, iqp->file_len);
 677
 678       if ((cf2 & IOPARM_INQUIRE_HAS_IQSTREAM) != 0)
 679         cf_strcpy (iqp->iqstream, iqp->iqstream_len, "UNKNOWN");
 680     }
 681
 682   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
 683     cf_strcpy (iqp->position, iqp->position_len, undefined);
 684
 685   if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
 686     cf_strcpy (iqp->access, iqp->access_len, undefined);
 687
 688   if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
 689     {
 690       p = inquire_read (iqp->file, iqp->file_len);
 691       cf_strcpy (iqp->read, iqp->read_len, p);
 692     }
 693
 694   if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
 695     {
 696       p = inquire_write (iqp->file, iqp->file_len);
 697       cf_strcpy (iqp->write, iqp->write_len, p);
 698     }
 699
 700   if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
 701     {
 702       p = inquire_read (iqp->file, iqp->file_len);
 703       cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
 704     }
 705 }
 706
 707
 708 /* Library entry point for the INQUIRE statement (non-IOLENGTH
 709    form).  */
 710
 711 extern void st_inquire (st_parameter_inquire *);
 712 export_proto(st_inquire);
 713
 714 void
 715 st_inquire (st_parameter_inquire *iqp)
 716 {
 717   gfc_unit *u;
 718
 719   library_start (&iqp->common);
 720
 721   if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0)
 722     {
 723       u = find_unit (iqp->common.unit);
 724       inquire_via_unit (iqp, u);
 725     }
 726   else
 727     {
 728       u = find_file (iqp->file, iqp->file_len);
 729       if (u == NULL)
 730         inquire_via_filename (iqp);
 731       else
 732         inquire_via_unit (iqp, u);
 733     }
 734   if (u != NULL)
 735     unlock_unit (u);
 736
 737   library_end ();
 738 }