1/* Copyright (C) 2002-2020 Free Software Foundation, Inc. 2 Contributed by Andy Vaught 3 4This file is part of the GNU Fortran runtime library (libgfortran). 5 6Libgfortran is free software; you can redistribute it and/or modify 7it under the terms of the GNU General Public License as published by 8the Free Software Foundation; either version 3, or (at your option) 9any later version. 10 11Libgfortran is distributed in the hope that it will be useful, 12but WITHOUT ANY WARRANTY; without even the implied warranty of 13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14GNU General Public License for more details. 15 16Under Section 7 of GPL version 3, you are granted additional 17permissions described in the GCC Runtime Library Exception, version 183.1, as published by the Free Software Foundation. 19 20You should have received a copy of the GNU General Public License and 21a copy of the GCC Runtime Library Exception along with this program; 22see 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 34static const char yes[] = "YES", no[] = "NO", undefined[] = "UNDEFINED"; 35 36 37/* inquire_via_unit()-- Inquiry via unit number. The unit might not exist. */ 38 39static void 40inquire_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 657static void 658inquire_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 786extern void st_inquire (st_parameter_inquire *); 787export_proto(st_inquire); 788 789void 790st_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