libgfortran/io/open.c

   1 /* Copyright (C) 2002, 2003, 2004, 2005, 2007
   2    Free Software Foundation, Inc.
   3    Contributed by Andy Vaught
   4
   5 This file is part of the GNU Fortran 95 runtime library (libgfortran).
   6
   7 Libgfortran is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 In addition to the permissions in the GNU General Public License, the
  13 Free Software Foundation gives you unlimited permission to link the
  14 compiled version of this file into combinations with other programs,
  15 and to distribute those combinations without any restriction coming
  16 from the use of this file.  (The General Public License restrictions
  17 do apply in other respects; for example, they cover modification of
  18 the file, and distribution when not linked into a combine
  19 executable.)
  20
  21 Libgfortran is distributed in the hope that it will be useful,
  22 but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 GNU General Public License for more details.
  25
  26 You should have received a copy of the GNU General Public License
  27 along with Libgfortran; see the file COPYING.  If not, write to
  28 the Free Software Foundation, 51 Franklin Street, Fifth Floor,
  29 Boston, MA 02110-1301, USA.  */
  30
  31 #include "io.h"
  32 #include <unistd.h>
  33 #include <string.h>
  34 #include <errno.h>
  35
  36
  37 static const st_option access_opt[] = {
  38   {"sequential", ACCESS_SEQUENTIAL},
  39   {"direct", ACCESS_DIRECT},
  40   {"append", ACCESS_APPEND},
  41   {"stream", ACCESS_STREAM},
  42   {NULL, 0}
  43 };
  44
  45 static const st_option action_opt[] =
  46 {
  47   { "read", ACTION_READ},
  48   { "write", ACTION_WRITE},
  49   { "readwrite", ACTION_READWRITE},
  50   { NULL, 0}
  51 };
  52
  53 static const st_option blank_opt[] =
  54 {
  55   { "null", BLANK_NULL},
  56   { "zero", BLANK_ZERO},
  57   { NULL, 0}
  58 };
  59
  60 static const st_option delim_opt[] =
  61 {
  62   { "none", DELIM_NONE},
  63   { "apostrophe", DELIM_APOSTROPHE},
  64   { "quote", DELIM_QUOTE},
  65   { NULL, 0}
  66 };
  67
  68 static const st_option form_opt[] =
  69 {
  70   { "formatted", FORM_FORMATTED},
  71   { "unformatted", FORM_UNFORMATTED},
  72   { NULL, 0}
  73 };
  74
  75 static const st_option position_opt[] =
  76 {
  77   { "asis", POSITION_ASIS},
  78   { "rewind", POSITION_REWIND},
  79   { "append", POSITION_APPEND},
  80   { NULL, 0}
  81 };
  82
  83 static const st_option status_opt[] =
  84 {
  85   { "unknown", STATUS_UNKNOWN},
  86   { "old", STATUS_OLD},
  87   { "new", STATUS_NEW},
  88   { "replace", STATUS_REPLACE},
  89   { "scratch", STATUS_SCRATCH},
  90   { NULL, 0}
  91 };
  92
  93 static const st_option pad_opt[] =
  94 {
  95   { "yes", PAD_YES},
  96   { "no", PAD_NO},
  97   { NULL, 0}
  98 };
  99
 100 static const st_option convert_opt[] =
 101 {
 102   { "native", GFC_CONVERT_NATIVE},
 103   { "swap", GFC_CONVERT_SWAP},
 104   { "big_endian", GFC_CONVERT_BIG},
 105   { "little_endian", GFC_CONVERT_LITTLE},
 106   { NULL, 0}
 107 };
 108
 109
 110 /* Given a unit, test to see if the file is positioned at the terminal
 111    point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
 112    This prevents us from changing the state from AFTER_ENDFILE to
 113    AT_ENDFILE.  */
 114
 115 static void
 116 test_endfile (gfc_unit * u)
 117 {
 118   if (u->endfile == NO_ENDFILE && file_length (u->s) == file_position (u->s))
 119     u->endfile = AT_ENDFILE;
 120 }
 121
 122
 123 /* Change the modes of a file, those that are allowed * to be
 124    changed.  */
 125
 126 static void
 127 edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
 128 {
 129   /* Complain about attempts to change the unchangeable.  */
 130
 131   if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD &&
 132       u->flags.status != flags->status)
 133     generate_error (&opp->common, LIBERROR_BAD_OPTION,
 134                     "Cannot change STATUS parameter in OPEN statement");
 135
 136   if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access)
 137     generate_error (&opp->common, LIBERROR_BAD_OPTION,
 138                     "Cannot change ACCESS parameter in OPEN statement");
 139
 140   if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form)
 141     generate_error (&opp->common, LIBERROR_BAD_OPTION,
 142                     "Cannot change FORM parameter in OPEN statement");
 143
 144   if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN)
 145       && opp->recl_in != u->recl)
 146     generate_error (&opp->common, LIBERROR_BAD_OPTION,
 147                     "Cannot change RECL parameter in OPEN statement");
 148
 149   if (flags->action != ACTION_UNSPECIFIED && u->flags.action != flags->action)
 150     generate_error (&opp->common, LIBERROR_BAD_OPTION,
 151                     "Cannot change ACTION parameter in OPEN statement");
 152
 153   /* Status must be OLD if present.  */
 154
 155   if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD &&
 156       flags->status != STATUS_UNKNOWN)
 157     {
 158       if (flags->status == STATUS_SCRATCH)
 159         notify_std (&opp->common, GFC_STD_GNU,
 160                     "OPEN statement must have a STATUS of OLD or UNKNOWN");
 161       else
 162         generate_error (&opp->common, LIBERROR_BAD_OPTION,
 163                     "OPEN statement must have a STATUS of OLD or UNKNOWN");
 164     }
 165
 166   if (u->flags.form == FORM_UNFORMATTED)
 167     {
 168       if (flags->delim != DELIM_UNSPECIFIED)
 169         generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
 170                         "DELIM parameter conflicts with UNFORMATTED form in "
 171                         "OPEN statement");
 172
 173       if (flags->blank != BLANK_UNSPECIFIED)
 174         generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
 175                         "BLANK parameter conflicts with UNFORMATTED form in "
 176                         "OPEN statement");
 177
 178       if (flags->pad != PAD_UNSPECIFIED)
 179         generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
 180                         "PAD parameter conflicts with UNFORMATTED form in "
 181                         "OPEN statement");
 182     }
 183
 184   if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
 185     {
 186       /* Change the changeable:  */
 187       if (flags->blank != BLANK_UNSPECIFIED)
 188         u->flags.blank = flags->blank;
 189       if (flags->delim != DELIM_UNSPECIFIED)
 190         u->flags.delim = flags->delim;
 191       if (flags->pad != PAD_UNSPECIFIED)
 192         u->flags.pad = flags->pad;
 193     }
 194
 195   /* Reposition the file if necessary.  */
 196
 197   switch (flags->position)
 198     {
 199     case POSITION_UNSPECIFIED:
 200     case POSITION_ASIS:
 201       break;
 202
 203     case POSITION_REWIND:
 204       if (sseek (u->s, 0) == FAILURE)
 205         goto seek_error;
 206
 207       u->current_record = 0;
 208       u->last_record = 0;
 209
 210       test_endfile (u);
 211       break;
 212
 213     case POSITION_APPEND:
 214       if (sseek (u->s, file_length (u->s)) == FAILURE)
 215         goto seek_error;
 216
 217       if (flags->access != ACCESS_STREAM)
 218         u->current_record = 0;
 219
 220       u->endfile = AT_ENDFILE;  /* We are at the end.  */
 221       break;
 222
 223     seek_error:
 224       generate_error (&opp->common, LIBERROR_OS, NULL);
 225       break;
 226     }
 227
 228   unlock_unit (u);
 229 }
 230
 231
 232 /* Open an unused unit.  */
 233
 234 gfc_unit *
 235 new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
 236 {
 237   gfc_unit *u2;
 238   stream *s;
 239   char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
 240
 241   /* Change unspecifieds to defaults.  Leave (flags->action ==
 242      ACTION_UNSPECIFIED) alone so open_external() can set it based on
 243      what type of open actually works.  */
 244
 245   if (flags->access == ACCESS_UNSPECIFIED)
 246     flags->access = ACCESS_SEQUENTIAL;
 247
 248   if (flags->form == FORM_UNSPECIFIED)
 249     flags->form = (flags->access == ACCESS_SEQUENTIAL)
 250       ? FORM_FORMATTED : FORM_UNFORMATTED;
 251
 252
 253   if (flags->delim == DELIM_UNSPECIFIED)
 254     flags->delim = DELIM_NONE;
 255   else
 256     {
 257       if (flags->form == FORM_UNFORMATTED)
 258         {
 259           generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
 260                           "DELIM parameter conflicts with UNFORMATTED form in "
 261                           "OPEN statement");
 262           goto fail;
 263         }
 264     }
 265
 266   if (flags->blank == BLANK_UNSPECIFIED)
 267     flags->blank = BLANK_NULL;
 268   else
 269     {
 270       if (flags->form == FORM_UNFORMATTED)
 271         {
 272           generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
 273                           "BLANK parameter conflicts with UNFORMATTED form in "
 274                           "OPEN statement");
 275           goto fail;
 276         }
 277     }
 278
 279   if (flags->pad == PAD_UNSPECIFIED)
 280     flags->pad = PAD_YES;
 281   else
 282     {
 283       if (flags->form == FORM_UNFORMATTED)
 284         {
 285           generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
 286                           "PAD parameter conflicts with UNFORMATTED form in "
 287                           "OPEN statement");
 288           goto fail;
 289         }
 290     }
 291
 292   if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT)
 293    {
 294      generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
 295                      "ACCESS parameter conflicts with SEQUENTIAL access in "
 296                      "OPEN statement");
 297      goto fail;
 298    }
 299   else
 300    if (flags->position == POSITION_UNSPECIFIED)
 301      flags->position = POSITION_ASIS;
 302
 303
 304   if (flags->status == STATUS_UNSPECIFIED)
 305     flags->status = STATUS_UNKNOWN;
 306
 307   /* Checks.  */
 308
 309   if (flags->access == ACCESS_DIRECT
 310       && (opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) == 0)
 311     {
 312       generate_error (&opp->common, LIBERROR_MISSING_OPTION,
 313                       "Missing RECL parameter in OPEN statement");
 314       goto fail;
 315     }
 316
 317   if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) && opp->recl_in <= 0)
 318     {
 319       generate_error (&opp->common, LIBERROR_BAD_OPTION,
 320                       "RECL parameter is non-positive in OPEN statement");
 321       goto fail;
 322     }
 323
 324   switch (flags->status)
 325     {
 326     case STATUS_SCRATCH:
 327       if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0)
 328         {
 329           opp->file = NULL;
 330           break;
 331         }
 332
 333       generate_error (&opp->common, LIBERROR_BAD_OPTION,
 334                       "FILE parameter must not be present in OPEN statement");
 335       goto fail;
 336
 337     case STATUS_OLD:
 338     case STATUS_NEW:
 339     case STATUS_REPLACE:
 340     case STATUS_UNKNOWN:
 341       if ((opp->common.flags & IOPARM_OPEN_HAS_FILE))
 342         break;
 343
 344       opp->file = tmpname;
 345 #ifdef HAVE_SNPRINTF
 346       opp->file_len = snprintf(opp->file, sizeof (tmpname), "fort.%d",
 347                                (int) opp->common.unit);
 348 #else
 349       opp->file_len = sprintf(opp->file, "fort.%d", (int) opp->common.unit);
 350 #endif
 351       break;
 352
 353     default:
 354       internal_error (&opp->common, "new_unit(): Bad status");
 355     }
 356
 357   /* Make sure the file isn't already open someplace else.
 358      Do not error if opening file preconnected to stdin, stdout, stderr.  */
 359
 360   u2 = NULL;
 361   if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) != 0)
 362     u2 = find_file (opp->file, opp->file_len);
 363   if (u2 != NULL
 364       && (options.stdin_unit < 0 || u2->unit_number != options.stdin_unit)
 365       && (options.stdout_unit < 0 || u2->unit_number != options.stdout_unit)
 366       && (options.stderr_unit < 0 || u2->unit_number != options.stderr_unit))
 367     {
 368       unlock_unit (u2);
 369       generate_error (&opp->common, LIBERROR_ALREADY_OPEN, NULL);
 370       goto cleanup;
 371     }
 372
 373   if (u2 != NULL)
 374     unlock_unit (u2);
 375
 376   /* Open file.  */
 377
 378   s = open_external (opp, flags);
 379   if (s == NULL)
 380     {
 381       char *path, *msg;
 382       path = (char *) gfc_alloca (opp->file_len + 1);
 383       msg = (char *) gfc_alloca (opp->file_len + 51);
 384       unpack_filename (path, opp->file, opp->file_len);
 385
 386       switch (errno)
 387         {
 388         case ENOENT:
 389           sprintf (msg, "File '%s' does not exist", path);
 390           break;
 391
 392         case EEXIST:
 393           sprintf (msg, "File '%s' already exists", path);
 394           break;
 395
 396         case EACCES:
 397           sprintf (msg, "Permission denied trying to open file '%s'", path);
 398           break;
 399
 400         case EISDIR:
 401           sprintf (msg, "'%s' is a directory", path);
 402           break;
 403
 404         default:
 405           msg = NULL;
 406         }
 407
 408       generate_error (&opp->common, LIBERROR_OS, msg);
 409       goto cleanup;
 410     }
 411
 412   if (flags->status == STATUS_NEW || flags->status == STATUS_REPLACE)
 413     flags->status = STATUS_OLD;
 414
 415   /* Create the unit structure.  */
 416
 417   u->file = get_mem (opp->file_len);
 418   if (u->unit_number != opp->common.unit)
 419     internal_error (&opp->common, "Unit number changed");
 420   u->s = s;
 421   u->flags = *flags;
 422   u->read_bad = 0;
 423   u->endfile = NO_ENDFILE;
 424   u->last_record = 0;
 425   u->current_record = 0;
 426   u->mode = READING;
 427   u->maxrec = 0;
 428   u->bytes_left = 0;
 429   u->saved_pos = 0;
 430
 431   if (flags->position == POSITION_APPEND)
 432     {
 433       if (sseek (u->s, file_length (u->s)) == FAILURE)
 434         generate_error (&opp->common, LIBERROR_OS, NULL);
 435       u->endfile = AT_ENDFILE;
 436     }
 437
 438   /* Unspecified recl ends up with a processor dependent value.  */
 439
 440   if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN))
 441     {
 442       u->flags.has_recl = 1;
 443       u->recl = opp->recl_in;
 444       u->recl_subrecord = u->recl;
 445       u->bytes_left = u->recl;
 446     }
 447   else
 448     {
 449       u->flags.has_recl = 0;
 450       u->recl = max_offset;
 451       if (compile_options.max_subrecord_length)
 452         {
 453           u->recl_subrecord = compile_options.max_subrecord_length;
 454         }
 455       else
 456         {
 457           switch (compile_options.record_marker)
 458             {
 459             case 0:
 460               /* Fall through */
 461             case sizeof (GFC_INTEGER_4):
 462               u->recl_subrecord = GFC_MAX_SUBRECORD_LENGTH;
 463               break;
 464
 465             case sizeof (GFC_INTEGER_8):
 466               u->recl_subrecord = max_offset - 16;
 467               break;
 468
 469             default:
 470               runtime_error ("Illegal value for record marker");
 471               break;
 472             }
 473         }
 474     }
 475
 476   /* If the file is direct access, calculate the maximum record number
 477      via a division now instead of letting the multiplication overflow
 478      later.  */
 479
 480   if (flags->access == ACCESS_DIRECT)
 481     u->maxrec = max_offset / u->recl;
 482
 483   if (flags->access == ACCESS_STREAM)
 484     {
 485       u->maxrec = max_offset;
 486       u->recl = 1;
 487       u->strm_pos = 1;
 488     }
 489
 490   memmove (u->file, opp->file, opp->file_len);
 491   u->file_len = opp->file_len;
 492
 493   /* Curiously, the standard requires that the
 494      position specifier be ignored for new files so a newly connected
 495      file starts out at the initial point.  We still need to figure
 496      out if the file is at the end or not.  */
 497
 498   test_endfile (u);
 499
 500   if (flags->status == STATUS_SCRATCH && opp->file != NULL)
 501     free_mem (opp->file);
 502   return u;
 503
 504  cleanup:
 505
 506   /* Free memory associated with a temporary filename.  */
 507
 508   if (flags->status == STATUS_SCRATCH && opp->file != NULL)
 509     free_mem (opp->file);
 510
 511  fail:
 512
 513   close_unit (u);
 514   return NULL;
 515 }
 516
 517
 518 /* Open a unit which is already open.  This involves changing the
 519    modes or closing what is there now and opening the new file.  */
 520
 521 static void
 522 already_open (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
 523 {
 524   if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0)
 525     {
 526       edit_modes (opp, u, flags);
 527       return;
 528     }
 529
 530   /* If the file is connected to something else, close it and open a
 531      new unit.  */
 532
 533   if (!compare_file_filename (u, opp->file, opp->file_len))
 534     {
 535 #if !HAVE_UNLINK_OPEN_FILE
 536       char *path = NULL;
 537       if (u->file && u->flags.status == STATUS_SCRATCH)
 538         {
 539           path = (char *) gfc_alloca (u->file_len + 1);
 540           unpack_filename (path, u->file, u->file_len);
 541         }
 542 #endif
 543
 544       if (sclose (u->s) == FAILURE)
 545         {
 546           unlock_unit (u);
 547           generate_error (&opp->common, LIBERROR_OS,
 548                           "Error closing file in OPEN statement");
 549           return;
 550         }
 551
 552       u->s = NULL;
 553       if (u->file)
 554         free_mem (u->file);
 555       u->file = NULL;
 556       u->file_len = 0;
 557
 558 #if !HAVE_UNLINK_OPEN_FILE
 559       if (path != NULL)
 560         unlink (path);
 561 #endif
 562
 563       u = new_unit (opp, u, flags);
 564       if (u != NULL)
 565         unlock_unit (u);
 566       return;
 567     }
 568
 569   edit_modes (opp, u, flags);
 570 }
 571
 572
 573 /* Open file.  */
 574
 575 extern void st_open (st_parameter_open *opp);
 576 export_proto(st_open);
 577
 578 void
 579 st_open (st_parameter_open *opp)
 580 {
 581   unit_flags flags;
 582   gfc_unit *u = NULL;
 583   GFC_INTEGER_4 cf = opp->common.flags;
 584   unit_convert conv;
 585
 586   library_start (&opp->common);
 587
 588   /* Decode options.  */
 589
 590   flags.access = !(cf & IOPARM_OPEN_HAS_ACCESS) ? ACCESS_UNSPECIFIED :
 591     find_option (&opp->common, opp->access, opp->access_len,
 592                  access_opt, "Bad ACCESS parameter in OPEN statement");
 593
 594   flags.action = !(cf & IOPARM_OPEN_HAS_ACTION) ? ACTION_UNSPECIFIED :
 595     find_option (&opp->common, opp->action, opp->action_len,
 596                  action_opt, "Bad ACTION parameter in OPEN statement");
 597
 598   flags.blank = !(cf & IOPARM_OPEN_HAS_BLANK) ? BLANK_UNSPECIFIED :
 599     find_option (&opp->common, opp->blank, opp->blank_len,
 600                  blank_opt, "Bad BLANK parameter in OPEN statement");
 601
 602   flags.delim = !(cf & IOPARM_OPEN_HAS_DELIM) ? DELIM_UNSPECIFIED :
 603     find_option (&opp->common, opp->delim, opp->delim_len,
 604                  delim_opt, "Bad DELIM parameter in OPEN statement");
 605
 606   flags.pad = !(cf & IOPARM_OPEN_HAS_PAD) ? PAD_UNSPECIFIED :
 607     find_option (&opp->common, opp->pad, opp->pad_len,
 608                  pad_opt, "Bad PAD parameter in OPEN statement");
 609
 610   flags.form = !(cf & IOPARM_OPEN_HAS_FORM) ? FORM_UNSPECIFIED :
 611     find_option (&opp->common, opp->form, opp->form_len,
 612                  form_opt, "Bad FORM parameter in OPEN statement");
 613
 614   flags.position = !(cf & IOPARM_OPEN_HAS_POSITION) ? POSITION_UNSPECIFIED :
 615     find_option (&opp->common, opp->position, opp->position_len,
 616                  position_opt, "Bad POSITION parameter in OPEN statement");
 617
 618   flags.status = !(cf & IOPARM_OPEN_HAS_STATUS) ? STATUS_UNSPECIFIED :
 619     find_option (&opp->common, opp->status, opp->status_len,
 620                  status_opt, "Bad STATUS parameter in OPEN statement");
 621
 622   /* First, we check wether the convert flag has been set via environment
 623      variable.  This overrides the convert tag in the open statement.  */
 624
 625   conv = get_unformatted_convert (opp->common.unit);
 626
 627   if (conv == GFC_CONVERT_NONE)
 628     {
 629       /* Nothing has been set by environment variable, check the convert tag.  */
 630       if (cf & IOPARM_OPEN_HAS_CONVERT)
 631         conv = find_option (&opp->common, opp->convert, opp->convert_len,
 632                             convert_opt,
 633                             "Bad CONVERT parameter in OPEN statement");
 634       else
 635         conv = compile_options.convert;
 636     }
 637
 638   /* We use l8_to_l4_offset, which is 0 on little-endian machines
 639      and 1 on big-endian machines.  */
 640   switch (conv)
 641     {
 642     case GFC_CONVERT_NATIVE:
 643     case GFC_CONVERT_SWAP:
 644       break;
 645
 646     case GFC_CONVERT_BIG:
 647       conv = l8_to_l4_offset ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP;
 648       break;
 649
 650     case GFC_CONVERT_LITTLE:
 651       conv = l8_to_l4_offset ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE;
 652       break;
 653
 654     default:
 655       internal_error (&opp->common, "Illegal value for CONVERT");
 656       break;
 657     }
 658
 659   flags.convert = conv;
 660
 661   if (opp->common.unit < 0)
 662     generate_error (&opp->common, LIBERROR_BAD_OPTION,
 663                     "Bad unit number in OPEN statement");
 664
 665   if (flags.position != POSITION_UNSPECIFIED
 666       && flags.access == ACCESS_DIRECT)
 667     generate_error (&opp->common, LIBERROR_BAD_OPTION,
 668                     "Cannot use POSITION with direct access files");
 669
 670   if (flags.access == ACCESS_APPEND)
 671     {
 672       if (flags.position != POSITION_UNSPECIFIED
 673           && flags.position != POSITION_APPEND)
 674         generate_error (&opp->common, LIBERROR_BAD_OPTION,
 675                         "Conflicting ACCESS and POSITION flags in"
 676                         " OPEN statement");
 677
 678       notify_std (&opp->common, GFC_STD_GNU,
 679                   "Extension: APPEND as a value for ACCESS in OPEN statement");
 680       flags.access = ACCESS_SEQUENTIAL;
 681       flags.position = POSITION_APPEND;
 682     }
 683
 684   if (flags.position == POSITION_UNSPECIFIED)
 685     flags.position = POSITION_ASIS;
 686
 687   if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
 688     {
 689       u = find_or_create_unit (opp->common.unit);
 690
 691       if (u->s == NULL)
 692         {
 693           u = new_unit (opp, u, &flags);
 694           if (u != NULL)
 695             unlock_unit (u);
 696         }
 697       else
 698         already_open (opp, u, &flags);
 699     }
 700
 701   library_end ();
 702 }