1 /* Copyright (C) 2002-2022 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 "async.h" 30 #include "unix.h" 31 #include <string.h> 32 33 34 static const char yes[] = "YES", no[] = "NO", 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 (iqp->common.unit == GFC_INTERNAL_UNIT || 46 iqp->common.unit == GFC_INTERNAL_UNIT4 || 47 (u != NULL && u->internal_unit_kind != 0)) 48 generate_error (&iqp->common, LIBERROR_INQUIRE_INTERNAL_UNIT, NULL); 49 50 if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) 51 *iqp->exist = (u != NULL && 52 iqp->common.unit != GFC_INTERNAL_UNIT && 53 iqp->common.unit != GFC_INTERNAL_UNIT4) 54 || (iqp->common.unit >= 0); 55 56 if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0) 57 *iqp->opened = (u != NULL); 58 59 if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0) 60 *iqp->number = (u != NULL) ? u->unit_number : -1; 61 62 if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0) 63 *iqp->named = (u != NULL && u->flags.status != STATUS_SCRATCH); 64 65 if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0 66 && u != NULL && u->flags.status != STATUS_SCRATCH) 67 { 68 #if defined(HAVE_TTYNAME_R) || defined(HAVE_TTYNAME) 69 if (u->unit_number == options.stdin_unit 70 || u->unit_number == options.stdout_unit 71 || u->unit_number == options.stderr_unit) 72 { 73 int err = stream_ttyname (u->s, iqp->name, iqp->name_len); 74 if (err == 0) 75 { 76 gfc_charlen_type tmplen = strlen (iqp->name); 77 if (iqp->name_len > tmplen) 78 memset (&iqp->name[tmplen], ' ', iqp->name_len - tmplen); 79 } 80 else /* If ttyname does not work, go with the default. */ 81 cf_strcpy (iqp->name, iqp->name_len, u->filename); 82 } 83 else 84 cf_strcpy (iqp->name, iqp->name_len, u->filename); 85 #elif defined __MINGW32__ 86 if (u->unit_number == options.stdin_unit) 87 fstrcpy (iqp->name, iqp->name_len, "CONIN$", sizeof("CONIN$")); 88 else if (u->unit_number == options.stdout_unit) 89 fstrcpy (iqp->name, iqp->name_len, "CONOUT$", sizeof("CONOUT$")); 90 else if (u->unit_number == options.stderr_unit) 91 fstrcpy (iqp->name, iqp->name_len, "CONERR$", sizeof("CONERR$")); 92 else 93 cf_strcpy (iqp->name, iqp->name_len, u->filename); 94 #else 95 cf_strcpy (iqp->name, iqp->name_len, u->filename); 96 #endif 97 } 98 99 if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0) 100 { 101 if (u == NULL) 102 p = undefined; 103 else 104 switch (u->flags.access) 105 { 106 case ACCESS_SEQUENTIAL: 107 p = "SEQUENTIAL"; 108 break; 109 case ACCESS_DIRECT: 110 p = "DIRECT"; 111 break; 112 case ACCESS_STREAM: 113 p = "STREAM"; 114 break; 115 default: 116 internal_error (&iqp->common, "inquire_via_unit(): Bad access"); 117 } 118 119 cf_strcpy (iqp->access, iqp->access_len, p); 120 } 121 122 if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0) 123 { 124 if (u == NULL) 125 p = inquire_sequential (NULL, 0); 126 else 127 switch (u->flags.access) 128 { 129 case ACCESS_DIRECT: 130 case ACCESS_STREAM: 131 p = no; 132 break; 133 case ACCESS_SEQUENTIAL: 134 p = yes; 135 break; 136 default: 137 internal_error (&iqp->common, "inquire_via_unit(): Bad access"); 138 } 139 140 cf_strcpy (iqp->sequential, iqp->sequential_len, p); 141 } 142 143 if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0) 144 { 145 if (u == NULL) 146 p = inquire_direct (NULL, 0); 147 else 148 switch (u->flags.access) 149 { 150 case ACCESS_SEQUENTIAL: 151 case ACCESS_STREAM: 152 p = no; 153 break; 154 case ACCESS_DIRECT: 155 p = yes; 156 break; 157 default: 158 internal_error (&iqp->common, "inquire_via_unit(): Bad access"); 159 } 160 161 cf_strcpy (iqp->direct, iqp->direct_len, p); 162 } 163 164 if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0) 165 { 166 if (u == NULL) 167 p = undefined; 168 else 169 switch (u->flags.form) 170 { 171 case FORM_FORMATTED: 172 p = "FORMATTED"; 173 break; 174 case FORM_UNFORMATTED: 175 p = "UNFORMATTED"; 176 break; 177 default: 178 internal_error (&iqp->common, "inquire_via_unit(): Bad form"); 179 } 180 181 cf_strcpy (iqp->form, iqp->form_len, p); 182 } 183 184 if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0) 185 { 186 if (u == NULL) 187 p = inquire_formatted (NULL, 0); 188 else 189 switch (u->flags.form) 190 { 191 case FORM_FORMATTED: 192 p = yes; 193 break; 194 case FORM_UNFORMATTED: 195 p = no; 196 break; 197 default: 198 internal_error (&iqp->common, "inquire_via_unit(): Bad form"); 199 } 200 201 cf_strcpy (iqp->formatted, iqp->formatted_len, p); 202 } 203 204 if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0) 205 { 206 if (u == NULL) 207 p = inquire_unformatted (NULL, 0); 208 else 209 switch (u->flags.form) 210 { 211 case FORM_FORMATTED: 212 p = no; 213 break; 214 case FORM_UNFORMATTED: 215 p = yes; 216 break; 217 default: 218 internal_error (&iqp->common, "inquire_via_unit(): Bad form"); 219 } 220 221 cf_strcpy (iqp->unformatted, iqp->unformatted_len, p); 222 } 223 224 if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0) 225 /* F2018 (N2137) 12.10.2.26: If there is no connection, recl is 226 assigned the value -1. */ 227 *iqp->recl_out = (u != NULL) ? u->recl : -1; 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_ENCODING) != 0) 286 { 287 if (u == NULL || u->flags.form != FORM_FORMATTED) 288 p = undefined; 289 else 290 switch (u->flags.encoding) 291 { 292 case ENCODING_DEFAULT: 293 p = "UNKNOWN"; 294 break; 295 case ENCODING_UTF8: 296 p = "UTF-8"; 297 break; 298 default: 299 internal_error (&iqp->common, "inquire_via_unit(): Bad encoding"); 300 } 301 302 cf_strcpy (iqp->encoding, iqp->encoding_len, p); 303 } 304 305 if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0) 306 { 307 if (u == NULL || u->flags.form != FORM_FORMATTED) 308 p = undefined; 309 else 310 switch (u->flags.decimal) 311 { 312 case DECIMAL_POINT: 313 p = "POINT"; 314 break; 315 case DECIMAL_COMMA: 316 p = "COMMA"; 317 break; 318 default: 319 internal_error (&iqp->common, "inquire_via_unit(): Bad comma"); 320 } 321 322 cf_strcpy (iqp->decimal, iqp->decimal_len, p); 323 } 324 325 if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0) 326 { 327 if (u == NULL) 328 p = undefined; 329 else 330 { 331 switch (u->flags.async) 332 { 333 case ASYNC_YES: 334 p = yes; 335 break; 336 case ASYNC_NO: 337 p = no; 338 break; 339 default: 340 internal_error (&iqp->common, "inquire_via_unit(): Bad async"); 341 } 342 } 343 cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p); 344 } 345 346 if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0) 347 { 348 if (!ASYNC_IO || u->au == NULL) 349 *(iqp->pending) = 0; 350 else 351 { 352 LOCK (&(u->au->lock)); 353 if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0) 354 { 355 int id; 356 id = *(iqp->id); 357 *(iqp->pending) = id > u->au->id.low; 358 } 359 else 360 { 361 *(iqp->pending) = ! u->au->empty; 362 } 363 UNLOCK (&(u->au->lock)); 364 } 365 } 366 367 if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0) 368 { 369 if (u == NULL) 370 p = undefined; 371 else 372 switch (u->flags.sign) 373 { 374 case SIGN_PROCDEFINED: 375 p = "PROCESSOR_DEFINED"; 376 break; 377 case SIGN_SUPPRESS: 378 p = "SUPPRESS"; 379 break; 380 case SIGN_PLUS: 381 p = "PLUS"; 382 break; 383 default: 384 internal_error (&iqp->common, "inquire_via_unit(): Bad sign"); 385 } 386 387 cf_strcpy (iqp->sign, iqp->sign_len, p); 388 } 389 390 if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0) 391 { 392 if (u == NULL) 393 p = undefined; 394 else 395 switch (u->flags.round) 396 { 397 case ROUND_UP: 398 p = "UP"; 399 break; 400 case ROUND_DOWN: 401 p = "DOWN"; 402 break; 403 case ROUND_ZERO: 404 p = "ZERO"; 405 break; 406 case ROUND_NEAREST: 407 p = "NEAREST"; 408 break; 409 case ROUND_COMPATIBLE: 410 p = "COMPATIBLE"; 411 break; 412 case ROUND_PROCDEFINED: 413 p = "PROCESSOR_DEFINED"; 414 break; 415 default: 416 internal_error (&iqp->common, "inquire_via_unit(): Bad round"); 417 } 418 419 cf_strcpy (iqp->round, iqp->round_len, p); 420 } 421 422 if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0) 423 { 424 if (u == NULL) 425 *iqp->size = -1; 426 else 427 { 428 sflush (u->s); 429 *iqp->size = ssize (u->s); 430 } 431 } 432 433 if ((cf2 & IOPARM_INQUIRE_HAS_IQSTREAM) != 0) 434 { 435 if (u == NULL) 436 p = "UNKNOWN"; 437 else 438 switch (u->flags.access) 439 { 440 case ACCESS_SEQUENTIAL: 441 case ACCESS_DIRECT: 442 p = no; 443 break; 444 case ACCESS_STREAM: 445 p = yes; 446 break; 447 default: 448 internal_error (&iqp->common, "inquire_via_unit(): Bad pad"); 449 } 450 451 cf_strcpy (iqp->iqstream, iqp->iqstream_len, p); 452 } 453 454 if ((cf2 & IOPARM_INQUIRE_HAS_SHARE) != 0) 455 { 456 if (u == NULL) 457 p = "UNKNOWN"; 458 else 459 switch (u->flags.share) 460 { 461 case SHARE_DENYRW: 462 p = "DENYRW"; 463 break; 464 case SHARE_DENYNONE: 465 p = "DENYNONE"; 466 break; 467 case SHARE_UNSPECIFIED: 468 p = "NODENY"; 469 break; 470 default: 471 internal_error (&iqp->common, 472 "inquire_via_unit(): Bad share"); 473 break; 474 } 475 476 cf_strcpy (iqp->share, iqp->share_len, p); 477 } 478 479 if ((cf2 & IOPARM_INQUIRE_HAS_CC) != 0) 480 { 481 if (u == NULL) 482 p = "UNKNOWN"; 483 else 484 switch (u->flags.cc) 485 { 486 case CC_FORTRAN: 487 p = "FORTRAN"; 488 break; 489 case CC_LIST: 490 p = "LIST"; 491 break; 492 case CC_NONE: 493 p = "NONE"; 494 break; 495 case CC_UNSPECIFIED: 496 p = "UNKNOWN"; 497 break; 498 default: 499 internal_error (&iqp->common, "inquire_via_unit(): Bad cc"); 500 break; 501 } 502 503 cf_strcpy (iqp->cc, iqp->cc_len, p); 504 } 505 } 506 507 if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0) 508 { 509 if (u == NULL || u->flags.access == ACCESS_DIRECT) 510 p = undefined; 511 else 512 { 513 /* If the position is unspecified, check if we can figure 514 out whether it's at the beginning or end. */ 515 if (u->flags.position == POSITION_UNSPECIFIED) 516 { 517 gfc_offset cur = stell (u->s); 518 if (cur == 0) 519 u->flags.position = POSITION_REWIND; 520 else if (cur != -1 && (ssize (u->s) == cur)) 521 u->flags.position = POSITION_APPEND; 522 } 523 switch (u->flags.position) 524 { 525 case POSITION_REWIND: 526 p = "REWIND"; 527 break; 528 case POSITION_APPEND: 529 p = "APPEND"; 530 break; 531 case POSITION_ASIS: 532 p = "ASIS"; 533 break; 534 default: 535 /* If the position has changed and is not rewind or 536 append, it must be set to a processor-dependent 537 value. */ 538 p = "UNSPECIFIED"; 539 break; 540 } 541 } 542 cf_strcpy (iqp->position, iqp->position_len, p); 543 } 544 545 if ((cf & IOPARM_INQUIRE_HAS_ACTION) != 0) 546 { 547 if (u == NULL) 548 p = undefined; 549 else 550 switch (u->flags.action) 551 { 552 case ACTION_READ: 553 p = "READ"; 554 break; 555 case ACTION_WRITE: 556 p = "WRITE"; 557 break; 558 case ACTION_READWRITE: 559 p = "READWRITE"; 560 break; 561 default: 562 internal_error (&iqp->common, "inquire_via_unit(): Bad action"); 563 } 564 565 cf_strcpy (iqp->action, iqp->action_len, p); 566 } 567 568 if ((cf & IOPARM_INQUIRE_HAS_READ) != 0) 569 { 570 p = (!u || u->flags.action == ACTION_WRITE) ? no : yes; 571 cf_strcpy (iqp->read, iqp->read_len, p); 572 } 573 574 if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0) 575 { 576 p = (!u || u->flags.action == ACTION_READ) ? no : yes; 577 cf_strcpy (iqp->write, iqp->write_len, p); 578 } 579 580 if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0) 581 { 582 p = (!u || u->flags.action != ACTION_READWRITE) ? no : yes; 583 cf_strcpy (iqp->readwrite, iqp->readwrite_len, p); 584 } 585 586 if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0) 587 { 588 if (u == NULL || u->flags.form != FORM_FORMATTED) 589 p = undefined; 590 else 591 switch (u->flags.delim) 592 { 593 case DELIM_NONE: 594 case DELIM_UNSPECIFIED: 595 p = "NONE"; 596 break; 597 case DELIM_QUOTE: 598 p = "QUOTE"; 599 break; 600 case DELIM_APOSTROPHE: 601 p = "APOSTROPHE"; 602 break; 603 default: 604 internal_error (&iqp->common, "inquire_via_unit(): Bad delim"); 605 } 606 607 cf_strcpy (iqp->delim, iqp->delim_len, p); 608 } 609 610 if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0) 611 { 612 if (u == NULL || u->flags.form != FORM_FORMATTED) 613 p = undefined; 614 else 615 switch (u->flags.pad) 616 { 617 case PAD_NO: 618 p = no; 619 break; 620 case PAD_YES: 621 p = yes; 622 break; 623 default: 624 internal_error (&iqp->common, "inquire_via_unit(): Bad pad"); 625 } 626 627 cf_strcpy (iqp->pad, iqp->pad_len, p); 628 } 629 630 if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0) 631 { 632 if (u == NULL) 633 p = undefined; 634 else 635 switch (u->flags.convert) 636 { 637 case GFC_CONVERT_NATIVE: 638 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "BIG_ENDIAN" : "LITTLE_ENDIAN"; 639 break; 640 641 case GFC_CONVERT_SWAP: 642 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN" : "BIG_ENDIAN"; 643 break; 644 645 #ifdef HAVE_GFC_REAL_17 646 case GFC_CONVERT_NATIVE | GFC_CONVERT_R16_IEEE: 647 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "BIG_ENDIAN,R16_IEEE" : "LITTLE_ENDIAN,R16_IEEE"; 648 break; 649 650 case GFC_CONVERT_SWAP | GFC_CONVERT_R16_IEEE: 651 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN,R16_IEEE" : "BIG_ENDIAN,R16_IEEE"; 652 break; 653 654 case GFC_CONVERT_NATIVE | GFC_CONVERT_R16_IBM: 655 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "BIG_ENDIAN,R16_IBM" : "LITTLE_ENDIAN,R16_IBM"; 656 break; 657 658 case GFC_CONVERT_SWAP | GFC_CONVERT_R16_IBM: 659 p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN,R16_IBM" : "BIG_ENDIAN,R16_IBM"; 660 break; 661 #endif 662 663 default: 664 internal_error (&iqp->common, "inquire_via_unit(): Bad convert"); 665 } 666 667 cf_strcpy (iqp->convert, iqp->convert_len, p); 668 } 669 } 670 671 672 /* inquire_via_filename()-- Inquiry via filename. This subroutine is 673 only used if the filename is *not* connected to a unit number. */ 674 675 static void 676 inquire_via_filename (st_parameter_inquire *iqp) 677 { 678 const char *p; 679 GFC_INTEGER_4 cf = iqp->common.flags; 680 681 if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) 682 *iqp->exist = file_exists (iqp->file, iqp->file_len); 683 684 if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0) 685 *iqp->opened = 0; 686 687 if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0) 688 *iqp->number = -1; 689 690 if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0) 691 *iqp->named = 1; 692 693 if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0) 694 fstrcpy (iqp->name, iqp->name_len, iqp->file, iqp->file_len); 695 696 if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0) 697 cf_strcpy (iqp->access, iqp->access_len, undefined); 698 699 if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0) 700 { 701 p = "UNKNOWN"; 702 cf_strcpy (iqp->sequential, iqp->sequential_len, p); 703 } 704 705 if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0) 706 { 707 p = "UNKNOWN"; 708 cf_strcpy (iqp->direct, iqp->direct_len, p); 709 } 710 711 if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0) 712 cf_strcpy (iqp->form, iqp->form_len, undefined); 713 714 if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0) 715 { 716 p = "UNKNOWN"; 717 cf_strcpy (iqp->formatted, iqp->formatted_len, p); 718 } 719 720 if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0) 721 { 722 p = "UNKNOWN"; 723 cf_strcpy (iqp->unformatted, iqp->unformatted_len, p); 724 } 725 726 if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0) 727 /* F2018 (N2137) 12.10.2.26: If there is no connection, recl is 728 assigned the value -1. */ 729 *iqp->recl_out = -1; 730 731 if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0) 732 *iqp->nextrec = 0; 733 734 if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0) 735 cf_strcpy (iqp->blank, iqp->blank_len, undefined); 736 737 if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0) 738 cf_strcpy (iqp->pad, iqp->pad_len, undefined); 739 740 if (cf & IOPARM_INQUIRE_HAS_FLAGS2) 741 { 742 GFC_INTEGER_4 cf2 = iqp->flags2; 743 744 if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) 745 cf_strcpy (iqp->encoding, iqp->encoding_len, undefined); 746 747 if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0) 748 cf_strcpy (iqp->delim, iqp->delim_len, undefined); 749 750 if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0) 751 cf_strcpy (iqp->decimal, iqp->decimal_len, undefined); 752 753 if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0) 754 cf_strcpy (iqp->delim, iqp->delim_len, undefined); 755 756 if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0) 757 cf_strcpy (iqp->pad, iqp->pad_len, undefined); 758 759 if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) 760 cf_strcpy (iqp->encoding, iqp->encoding_len, undefined); 761 762 if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0) 763 *iqp->size = file_size (iqp->file, iqp->file_len); 764 765 if ((cf2 & IOPARM_INQUIRE_HAS_IQSTREAM) != 0) 766 cf_strcpy (iqp->iqstream, iqp->iqstream_len, "UNKNOWN"); 767 768 if ((cf2 & IOPARM_INQUIRE_HAS_SHARE) != 0) 769 cf_strcpy (iqp->share, iqp->share_len, "UNKNOWN"); 770 771 if ((cf2 & IOPARM_INQUIRE_HAS_CC) != 0) 772 cf_strcpy (iqp->cc, iqp->cc_len, "UNKNOWN"); 773 } 774 775 if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0) 776 cf_strcpy (iqp->position, iqp->position_len, undefined); 777 778 if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0) 779 cf_strcpy (iqp->access, iqp->access_len, undefined); 780 781 if ((cf & IOPARM_INQUIRE_HAS_READ) != 0) 782 { 783 p = inquire_read (iqp->file, iqp->file_len); 784 cf_strcpy (iqp->read, iqp->read_len, p); 785 } 786 787 if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0) 788 { 789 p = inquire_write (iqp->file, iqp->file_len); 790 cf_strcpy (iqp->write, iqp->write_len, p); 791 } 792 793 if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0) 794 { 795 p = inquire_read (iqp->file, iqp->file_len); 796 cf_strcpy (iqp->readwrite, iqp->readwrite_len, p); 797 } 798 } 799 800 801 /* Library entry point for the INQUIRE statement (non-IOLENGTH 802 form). */ 803 804 extern void st_inquire (st_parameter_inquire *); 805 export_proto(st_inquire); 806 807 void 808 st_inquire (st_parameter_inquire *iqp) 809 { 810 gfc_unit *u; 811 812 library_start (&iqp->common); 813 814 if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0) 815 { 816 u = find_unit (iqp->common.unit); 817 inquire_via_unit (iqp, u); 818 } 819 else 820 { 821 u = find_file (iqp->file, iqp->file_len); 822 if (u == NULL) 823 inquire_via_filename (iqp); 824 else 825 inquire_via_unit (iqp, u); 826 } 827 if (u != NULL) 828 unlock_unit (u); 829 830 library_end (); 831 } 832