1 /* Copyright (C) 2002-2020 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 default: 646 internal_error (&iqp->common, "inquire_via_unit(): Bad convert"); 647 } 648 649 cf_strcpy (iqp->convert, iqp->convert_len, p); 650 } 651 } 652 653 654 /* inquire_via_filename()-- Inquiry via filename. This subroutine is 655 only used if the filename is *not* connected to a unit number. */ 656 657 static void 658 inquire_via_filename (st_parameter_inquire *iqp) 659 { 660 const char *p; 661 GFC_INTEGER_4 cf = iqp->common.flags; 662 663 if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) 664 *iqp->exist = file_exists (iqp->file, iqp->file_len); 665 666 if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0) 667 *iqp->opened = 0; 668 669 if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0) 670 *iqp->number = -1; 671 672 if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0) 673 *iqp->named = 1; 674 675 if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0) 676 fstrcpy (iqp->name, iqp->name_len, iqp->file, iqp->file_len); 677 678 if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0) 679 cf_strcpy (iqp->access, iqp->access_len, undefined); 680 681 if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0) 682 { 683 p = "UNKNOWN"; 684 cf_strcpy (iqp->sequential, iqp->sequential_len, p); 685 } 686 687 if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0) 688 { 689 p = "UNKNOWN"; 690 cf_strcpy (iqp->direct, iqp->direct_len, p); 691 } 692 693 if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0) 694 cf_strcpy (iqp->form, iqp->form_len, undefined); 695 696 if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0) 697 { 698 p = "UNKNOWN"; 699 cf_strcpy (iqp->formatted, iqp->formatted_len, p); 700 } 701 702 if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0) 703 { 704 p = "UNKNOWN"; 705 cf_strcpy (iqp->unformatted, iqp->unformatted_len, p); 706 } 707 708 if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0) 709 /* F2018 (N2137) 12.10.2.26: If there is no connection, recl is 710 assigned the value -1. */ 711 *iqp->recl_out = -1; 712 713 if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0) 714 *iqp->nextrec = 0; 715 716 if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0) 717 cf_strcpy (iqp->blank, iqp->blank_len, undefined); 718 719 if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0) 720 cf_strcpy (iqp->pad, iqp->pad_len, undefined); 721 722 if (cf & IOPARM_INQUIRE_HAS_FLAGS2) 723 { 724 GFC_INTEGER_4 cf2 = iqp->flags2; 725 726 if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) 727 cf_strcpy (iqp->encoding, iqp->encoding_len, undefined); 728 729 if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0) 730 cf_strcpy (iqp->delim, iqp->delim_len, undefined); 731 732 if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0) 733 cf_strcpy (iqp->decimal, iqp->decimal_len, undefined); 734 735 if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0) 736 cf_strcpy (iqp->delim, iqp->delim_len, undefined); 737 738 if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0) 739 cf_strcpy (iqp->pad, iqp->pad_len, undefined); 740 741 if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) 742 cf_strcpy (iqp->encoding, iqp->encoding_len, undefined); 743 744 if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0) 745 *iqp->size = file_size (iqp->file, iqp->file_len); 746 747 if ((cf2 & IOPARM_INQUIRE_HAS_IQSTREAM) != 0) 748 cf_strcpy (iqp->iqstream, iqp->iqstream_len, "UNKNOWN"); 749 750 if ((cf2 & IOPARM_INQUIRE_HAS_SHARE) != 0) 751 cf_strcpy (iqp->share, iqp->share_len, "UNKNOWN"); 752 753 if ((cf2 & IOPARM_INQUIRE_HAS_CC) != 0) 754 cf_strcpy (iqp->cc, iqp->cc_len, "UNKNOWN"); 755 } 756 757 if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0) 758 cf_strcpy (iqp->position, iqp->position_len, undefined); 759 760 if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0) 761 cf_strcpy (iqp->access, iqp->access_len, undefined); 762 763 if ((cf & IOPARM_INQUIRE_HAS_READ) != 0) 764 { 765 p = inquire_read (iqp->file, iqp->file_len); 766 cf_strcpy (iqp->read, iqp->read_len, p); 767 } 768 769 if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0) 770 { 771 p = inquire_write (iqp->file, iqp->file_len); 772 cf_strcpy (iqp->write, iqp->write_len, p); 773 } 774 775 if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0) 776 { 777 p = inquire_read (iqp->file, iqp->file_len); 778 cf_strcpy (iqp->readwrite, iqp->readwrite_len, p); 779 } 780 } 781 782 783 /* Library entry point for the INQUIRE statement (non-IOLENGTH 784 form). */ 785 786 extern void st_inquire (st_parameter_inquire *); 787 export_proto(st_inquire); 788 789 void 790 st_inquire (st_parameter_inquire *iqp) 791 { 792 gfc_unit *u; 793 794 library_start (&iqp->common); 795 796 if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0) 797 { 798 u = find_unit (iqp->common.unit); 799 inquire_via_unit (iqp, u); 800 } 801 else 802 { 803 u = find_file (iqp->file, iqp->file_len); 804 if (u == NULL) 805 inquire_via_filename (iqp); 806 else 807 inquire_via_unit (iqp, u); 808 } 809 if (u != NULL) 810 unlock_unit (u); 811 812 library_end (); 813 } 814