Daily bump.
[official-gcc.git] / libgfortran / io / open.c
blob05aac8f6a8b8de72c3fb8db6fc69e62c809d4734
1 /* Copyright (C) 2002-2018 Free Software Foundation, Inc.
2 Contributed by Andy Vaught
3 F2003 I/O support contributed by Jerry DeLisle
5 This file is part of the GNU Fortran runtime library (libgfortran).
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 3, or (at your option)
10 any later version.
12 Libgfortran is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 Under Section 7 of GPL version 3, you are granted additional
18 permissions described in the GCC Runtime Library Exception, version
19 3.1, as published by the Free Software Foundation.
21 You should have received a copy of the GNU General Public License and
22 a copy of the GCC Runtime Library Exception along with this program;
23 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24 <http://www.gnu.org/licenses/>. */
26 #include "io.h"
27 #include "fbuf.h"
28 #include "unix.h"
30 #ifdef HAVE_UNISTD_H
31 #include <unistd.h>
32 #endif
34 #include <string.h>
35 #include <errno.h>
38 static const st_option access_opt[] = {
39 {"sequential", ACCESS_SEQUENTIAL},
40 {"direct", ACCESS_DIRECT},
41 {"append", ACCESS_APPEND},
42 {"stream", ACCESS_STREAM},
43 {NULL, 0}
46 static const st_option action_opt[] =
48 { "read", ACTION_READ},
49 { "write", ACTION_WRITE},
50 { "readwrite", ACTION_READWRITE},
51 { NULL, 0}
54 static const st_option share_opt[] =
56 { "denyrw", SHARE_DENYRW },
57 { "denynone", SHARE_DENYNONE },
58 { NULL, 0}
61 static const st_option cc_opt[] =
63 { "list", CC_LIST },
64 { "fortran", CC_FORTRAN },
65 { "none", CC_NONE },
66 { NULL, 0}
69 static const st_option blank_opt[] =
71 { "null", BLANK_NULL},
72 { "zero", BLANK_ZERO},
73 { NULL, 0}
76 static const st_option delim_opt[] =
78 { "none", DELIM_NONE},
79 { "apostrophe", DELIM_APOSTROPHE},
80 { "quote", DELIM_QUOTE},
81 { NULL, 0}
84 static const st_option form_opt[] =
86 { "formatted", FORM_FORMATTED},
87 { "unformatted", FORM_UNFORMATTED},
88 { NULL, 0}
91 static const st_option position_opt[] =
93 { "asis", POSITION_ASIS},
94 { "rewind", POSITION_REWIND},
95 { "append", POSITION_APPEND},
96 { NULL, 0}
99 static const st_option status_opt[] =
101 { "unknown", STATUS_UNKNOWN},
102 { "old", STATUS_OLD},
103 { "new", STATUS_NEW},
104 { "replace", STATUS_REPLACE},
105 { "scratch", STATUS_SCRATCH},
106 { NULL, 0}
109 static const st_option pad_opt[] =
111 { "yes", PAD_YES},
112 { "no", PAD_NO},
113 { NULL, 0}
116 static const st_option decimal_opt[] =
118 { "point", DECIMAL_POINT},
119 { "comma", DECIMAL_COMMA},
120 { NULL, 0}
123 static const st_option encoding_opt[] =
125 { "utf-8", ENCODING_UTF8},
126 { "default", ENCODING_DEFAULT},
127 { NULL, 0}
130 static const st_option round_opt[] =
132 { "up", ROUND_UP},
133 { "down", ROUND_DOWN},
134 { "zero", ROUND_ZERO},
135 { "nearest", ROUND_NEAREST},
136 { "compatible", ROUND_COMPATIBLE},
137 { "processor_defined", ROUND_PROCDEFINED},
138 { NULL, 0}
141 static const st_option sign_opt[] =
143 { "plus", SIGN_PLUS},
144 { "suppress", SIGN_SUPPRESS},
145 { "processor_defined", SIGN_PROCDEFINED},
146 { NULL, 0}
149 static const st_option convert_opt[] =
151 { "native", GFC_CONVERT_NATIVE},
152 { "swap", GFC_CONVERT_SWAP},
153 { "big_endian", GFC_CONVERT_BIG},
154 { "little_endian", GFC_CONVERT_LITTLE},
155 { NULL, 0}
158 static const st_option async_opt[] =
160 { "yes", ASYNC_YES},
161 { "no", ASYNC_NO},
162 { NULL, 0}
165 /* Given a unit, test to see if the file is positioned at the terminal
166 point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
167 This prevents us from changing the state from AFTER_ENDFILE to
168 AT_ENDFILE. */
170 static void
171 test_endfile (gfc_unit *u)
173 if (u->endfile == NO_ENDFILE)
175 gfc_offset sz = ssize (u->s);
176 if (sz == 0 || sz == stell (u->s))
177 u->endfile = AT_ENDFILE;
182 /* Change the modes of a file, those that are allowed * to be
183 changed. */
185 static void
186 edit_modes (st_parameter_open *opp, gfc_unit *u, unit_flags *flags)
188 /* Complain about attempts to change the unchangeable. */
190 if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD &&
191 u->flags.status != flags->status)
192 generate_error (&opp->common, LIBERROR_BAD_OPTION,
193 "Cannot change STATUS parameter in OPEN statement");
195 if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access)
196 generate_error (&opp->common, LIBERROR_BAD_OPTION,
197 "Cannot change ACCESS parameter in OPEN statement");
199 if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form)
200 generate_error (&opp->common, LIBERROR_BAD_OPTION,
201 "Cannot change FORM parameter in OPEN statement");
203 if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN)
204 && opp->recl_in != u->recl)
205 generate_error (&opp->common, LIBERROR_BAD_OPTION,
206 "Cannot change RECL parameter in OPEN statement");
208 if (flags->action != ACTION_UNSPECIFIED && u->flags.action != flags->action)
209 generate_error (&opp->common, LIBERROR_BAD_OPTION,
210 "Cannot change ACTION parameter in OPEN statement");
212 if (flags->share != SHARE_UNSPECIFIED && u->flags.share != flags->share)
213 generate_error (&opp->common, LIBERROR_BAD_OPTION,
214 "Cannot change SHARE parameter in OPEN statement");
216 if (flags->cc != CC_UNSPECIFIED && u->flags.cc != flags->cc)
217 generate_error (&opp->common, LIBERROR_BAD_OPTION,
218 "Cannot change CARRIAGECONTROL parameter in OPEN statement");
220 /* Status must be OLD if present. */
222 if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD &&
223 flags->status != STATUS_UNKNOWN)
225 if (flags->status == STATUS_SCRATCH)
226 notify_std (&opp->common, GFC_STD_GNU,
227 "OPEN statement must have a STATUS of OLD or UNKNOWN");
228 else
229 generate_error (&opp->common, LIBERROR_BAD_OPTION,
230 "OPEN statement must have a STATUS of OLD or UNKNOWN");
233 if (u->flags.form == FORM_UNFORMATTED)
235 if (flags->delim != DELIM_UNSPECIFIED)
236 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
237 "DELIM parameter conflicts with UNFORMATTED form in "
238 "OPEN statement");
240 if (flags->blank != BLANK_UNSPECIFIED)
241 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
242 "BLANK parameter conflicts with UNFORMATTED form in "
243 "OPEN statement");
245 if (flags->pad != PAD_UNSPECIFIED)
246 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
247 "PAD parameter conflicts with UNFORMATTED form in "
248 "OPEN statement");
250 if (flags->decimal != DECIMAL_UNSPECIFIED)
251 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
252 "DECIMAL parameter conflicts with UNFORMATTED form in "
253 "OPEN statement");
255 if (flags->encoding != ENCODING_UNSPECIFIED)
256 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
257 "ENCODING parameter conflicts with UNFORMATTED form in "
258 "OPEN statement");
260 if (flags->round != ROUND_UNSPECIFIED)
261 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
262 "ROUND parameter conflicts with UNFORMATTED form in "
263 "OPEN statement");
265 if (flags->sign != SIGN_UNSPECIFIED)
266 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
267 "SIGN parameter conflicts with UNFORMATTED form in "
268 "OPEN statement");
271 if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
273 /* Change the changeable: */
274 if (flags->blank != BLANK_UNSPECIFIED)
275 u->flags.blank = flags->blank;
276 if (flags->delim != DELIM_UNSPECIFIED)
277 u->flags.delim = flags->delim;
278 if (flags->pad != PAD_UNSPECIFIED)
279 u->flags.pad = flags->pad;
280 if (flags->decimal != DECIMAL_UNSPECIFIED)
281 u->flags.decimal = flags->decimal;
282 if (flags->encoding != ENCODING_UNSPECIFIED)
283 u->flags.encoding = flags->encoding;
284 if (flags->async != ASYNC_UNSPECIFIED)
285 u->flags.async = flags->async;
286 if (flags->round != ROUND_UNSPECIFIED)
287 u->flags.round = flags->round;
288 if (flags->sign != SIGN_UNSPECIFIED)
289 u->flags.sign = flags->sign;
291 /* Reposition the file if necessary. */
293 switch (flags->position)
295 case POSITION_UNSPECIFIED:
296 case POSITION_ASIS:
297 break;
299 case POSITION_REWIND:
300 if (sseek (u->s, 0, SEEK_SET) != 0)
301 goto seek_error;
303 u->current_record = 0;
304 u->last_record = 0;
306 test_endfile (u);
307 break;
309 case POSITION_APPEND:
310 if (sseek (u->s, 0, SEEK_END) < 0)
311 goto seek_error;
313 if (flags->access != ACCESS_STREAM)
314 u->current_record = 0;
316 u->endfile = AT_ENDFILE; /* We are at the end. */
317 break;
319 seek_error:
320 generate_error (&opp->common, LIBERROR_OS, NULL);
321 break;
325 unlock_unit (u);
329 /* Open an unused unit. */
331 gfc_unit *
332 new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags *flags)
334 gfc_unit *u2;
335 stream *s;
336 char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
338 /* Change unspecifieds to defaults. Leave (flags->action ==
339 ACTION_UNSPECIFIED) alone so open_external() can set it based on
340 what type of open actually works. */
342 if (flags->access == ACCESS_UNSPECIFIED)
343 flags->access = ACCESS_SEQUENTIAL;
345 if (flags->form == FORM_UNSPECIFIED)
346 flags->form = (flags->access == ACCESS_SEQUENTIAL)
347 ? FORM_FORMATTED : FORM_UNFORMATTED;
349 if (flags->async == ASYNC_UNSPECIFIED)
350 flags->async = ASYNC_NO;
352 if (flags->status == STATUS_UNSPECIFIED)
353 flags->status = STATUS_UNKNOWN;
355 if (flags->cc == CC_UNSPECIFIED)
356 flags->cc = flags->form == FORM_UNFORMATTED ? CC_NONE : CC_LIST;
357 else if (flags->form == FORM_UNFORMATTED && flags->cc != CC_NONE)
359 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
360 "CARRIAGECONTROL parameter conflicts with UNFORMATTED form in "
361 "OPEN statement");
362 goto fail;
365 /* Checks. */
367 if (flags->delim != DELIM_UNSPECIFIED
368 && flags->form == FORM_UNFORMATTED)
370 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
371 "DELIM parameter conflicts with UNFORMATTED form in "
372 "OPEN statement");
373 goto fail;
376 if (flags->blank == BLANK_UNSPECIFIED)
377 flags->blank = BLANK_NULL;
378 else
380 if (flags->form == FORM_UNFORMATTED)
382 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
383 "BLANK parameter conflicts with UNFORMATTED form in "
384 "OPEN statement");
385 goto fail;
389 if (flags->pad == PAD_UNSPECIFIED)
390 flags->pad = PAD_YES;
391 else
393 if (flags->form == FORM_UNFORMATTED)
395 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
396 "PAD parameter conflicts with UNFORMATTED form in "
397 "OPEN statement");
398 goto fail;
402 if (flags->decimal == DECIMAL_UNSPECIFIED)
403 flags->decimal = DECIMAL_POINT;
404 else
406 if (flags->form == FORM_UNFORMATTED)
408 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
409 "DECIMAL parameter conflicts with UNFORMATTED form "
410 "in OPEN statement");
411 goto fail;
415 if (flags->encoding == ENCODING_UNSPECIFIED)
416 flags->encoding = ENCODING_DEFAULT;
417 else
419 if (flags->form == FORM_UNFORMATTED)
421 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
422 "ENCODING parameter conflicts with UNFORMATTED form in "
423 "OPEN statement");
424 goto fail;
428 /* NB: the value for ROUND when it's not specified by the user does not
429 have to be PROCESSOR_DEFINED; the standard says that it is
430 processor dependent, and requires that it is one of the
431 possible value (see F2003, 9.4.5.13). */
432 if (flags->round == ROUND_UNSPECIFIED)
433 flags->round = ROUND_PROCDEFINED;
434 else
436 if (flags->form == FORM_UNFORMATTED)
438 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
439 "ROUND parameter conflicts with UNFORMATTED form in "
440 "OPEN statement");
441 goto fail;
445 if (flags->sign == SIGN_UNSPECIFIED)
446 flags->sign = SIGN_PROCDEFINED;
447 else
449 if (flags->form == FORM_UNFORMATTED)
451 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
452 "SIGN parameter conflicts with UNFORMATTED form in "
453 "OPEN statement");
454 goto fail;
458 if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT)
460 generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
461 "ACCESS parameter conflicts with SEQUENTIAL access in "
462 "OPEN statement");
463 goto fail;
465 else
466 if (flags->position == POSITION_UNSPECIFIED)
467 flags->position = POSITION_ASIS;
469 if (flags->access == ACCESS_DIRECT
470 && (opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) == 0)
472 generate_error (&opp->common, LIBERROR_MISSING_OPTION,
473 "Missing RECL parameter in OPEN statement");
474 goto fail;
477 if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) && opp->recl_in <= 0)
479 generate_error (&opp->common, LIBERROR_BAD_OPTION,
480 "RECL parameter is non-positive in OPEN statement");
481 goto fail;
484 switch (flags->status)
486 case STATUS_SCRATCH:
487 if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0)
489 opp->file = NULL;
490 break;
493 generate_error (&opp->common, LIBERROR_BAD_OPTION,
494 "FILE parameter must not be present in OPEN statement");
495 goto fail;
497 case STATUS_OLD:
498 case STATUS_NEW:
499 case STATUS_REPLACE:
500 case STATUS_UNKNOWN:
501 if ((opp->common.flags & IOPARM_OPEN_HAS_FILE))
502 break;
504 opp->file = tmpname;
505 opp->file_len = snprintf(opp->file, sizeof (tmpname), "fort.%d",
506 (int) opp->common.unit);
507 break;
509 default:
510 internal_error (&opp->common, "new_unit(): Bad status");
513 /* Make sure the file isn't already open someplace else.
514 Do not error if opening file preconnected to stdin, stdout, stderr. */
516 u2 = NULL;
517 if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) != 0)
518 u2 = find_file (opp->file, opp->file_len);
519 if (u2 != NULL
520 && (options.stdin_unit < 0 || u2->unit_number != options.stdin_unit)
521 && (options.stdout_unit < 0 || u2->unit_number != options.stdout_unit)
522 && (options.stderr_unit < 0 || u2->unit_number != options.stderr_unit))
524 unlock_unit (u2);
525 generate_error (&opp->common, LIBERROR_ALREADY_OPEN, NULL);
526 goto cleanup;
529 if (u2 != NULL)
530 unlock_unit (u2);
532 /* Open file. */
534 s = open_external (opp, flags);
535 if (s == NULL)
537 char errbuf[256];
538 char *path = fc_strdup (opp->file, opp->file_len);
539 size_t msglen = opp->file_len + 22 + sizeof (errbuf);
540 char *msg = xmalloc (msglen);
541 snprintf (msg, msglen, "Cannot open file '%s': %s", path,
542 gf_strerror (errno, errbuf, sizeof (errbuf)));
543 generate_error (&opp->common, LIBERROR_OS, msg);
544 free (msg);
545 free (path);
546 goto cleanup;
549 if (flags->status == STATUS_NEW || flags->status == STATUS_REPLACE)
550 flags->status = STATUS_OLD;
552 /* Create the unit structure. */
554 if (u->unit_number != opp->common.unit)
555 internal_error (&opp->common, "Unit number changed");
556 u->s = s;
557 u->flags = *flags;
558 u->read_bad = 0;
559 u->endfile = NO_ENDFILE;
560 u->last_record = 0;
561 u->current_record = 0;
562 u->mode = READING;
563 u->maxrec = 0;
564 u->bytes_left = 0;
565 u->saved_pos = 0;
567 if (flags->position == POSITION_APPEND)
569 if (sseek (u->s, 0, SEEK_END) < 0)
571 generate_error (&opp->common, LIBERROR_OS, NULL);
572 goto cleanup;
574 u->endfile = AT_ENDFILE;
577 /* Unspecified recl ends up with a processor dependent value. */
579 if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN))
581 u->flags.has_recl = 1;
582 u->recl = opp->recl_in;
583 u->recl_subrecord = u->recl;
584 u->bytes_left = u->recl;
586 else
588 u->flags.has_recl = 0;
589 u->recl = default_recl;
590 if (compile_options.max_subrecord_length)
592 u->recl_subrecord = compile_options.max_subrecord_length;
594 else
596 switch (compile_options.record_marker)
598 case 0:
599 /* Fall through */
600 case sizeof (GFC_INTEGER_4):
601 u->recl_subrecord = GFC_MAX_SUBRECORD_LENGTH;
602 break;
604 case sizeof (GFC_INTEGER_8):
605 u->recl_subrecord = max_offset - 16;
606 break;
608 default:
609 runtime_error ("Illegal value for record marker");
610 break;
615 /* If the file is direct access, calculate the maximum record number
616 via a division now instead of letting the multiplication overflow
617 later. */
619 if (flags->access == ACCESS_DIRECT)
620 u->maxrec = max_offset / u->recl;
622 if (flags->access == ACCESS_STREAM)
624 u->maxrec = max_offset;
625 /* F2018 (N2137) 12.10.2.26: If the connection is for stream
626 access recl is assigned the value -2. */
627 u->recl = -2;
628 u->bytes_left = 1;
629 u->strm_pos = stell (u->s) + 1;
632 u->filename = fc_strdup (opp->file, opp->file_len);
634 /* Curiously, the standard requires that the
635 position specifier be ignored for new files so a newly connected
636 file starts out at the initial point. We still need to figure
637 out if the file is at the end or not. */
639 test_endfile (u);
641 if (flags->status == STATUS_SCRATCH && opp->file != NULL)
642 free (opp->file);
644 if (flags->form == FORM_FORMATTED)
646 if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN))
647 fbuf_init (u, u->recl);
648 else
649 fbuf_init (u, 0);
651 else
652 u->fbuf = NULL;
656 return u;
658 cleanup:
660 /* Free memory associated with a temporary filename. */
662 if (flags->status == STATUS_SCRATCH && opp->file != NULL)
663 free (opp->file);
665 fail:
667 close_unit (u);
668 return NULL;
672 /* Open a unit which is already open. This involves changing the
673 modes or closing what is there now and opening the new file. */
675 static void
676 already_open (st_parameter_open *opp, gfc_unit *u, unit_flags *flags)
678 if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0)
680 edit_modes (opp, u, flags);
681 return;
684 /* If the file is connected to something else, close it and open a
685 new unit. */
687 if (!compare_file_filename (u, opp->file, opp->file_len))
689 if (sclose (u->s) == -1)
691 unlock_unit (u);
692 generate_error (&opp->common, LIBERROR_OS,
693 "Error closing file in OPEN statement");
694 return;
697 u->s = NULL;
699 #if !HAVE_UNLINK_OPEN_FILE
700 if (u->filename && u->flags.status == STATUS_SCRATCH)
701 remove (u->filename);
702 #endif
703 free (u->filename);
704 u->filename = NULL;
706 u = new_unit (opp, u, flags);
707 if (u != NULL)
708 unlock_unit (u);
709 return;
712 edit_modes (opp, u, flags);
716 /* Open file. */
718 extern void st_open (st_parameter_open *opp);
719 export_proto(st_open);
721 void
722 st_open (st_parameter_open *opp)
724 unit_flags flags;
725 gfc_unit *u = NULL;
726 GFC_INTEGER_4 cf = opp->common.flags;
727 unit_convert conv;
729 library_start (&opp->common);
731 /* Decode options. */
732 flags.readonly = !(cf & IOPARM_OPEN_HAS_READONLY) ? 0 : opp->readonly;
734 flags.access = !(cf & IOPARM_OPEN_HAS_ACCESS) ? ACCESS_UNSPECIFIED :
735 find_option (&opp->common, opp->access, opp->access_len,
736 access_opt, "Bad ACCESS parameter in OPEN statement");
738 flags.action = !(cf & IOPARM_OPEN_HAS_ACTION) ? ACTION_UNSPECIFIED :
739 find_option (&opp->common, opp->action, opp->action_len,
740 action_opt, "Bad ACTION parameter in OPEN statement");
742 flags.cc = !(cf & IOPARM_OPEN_HAS_CC) ? CC_UNSPECIFIED :
743 find_option (&opp->common, opp->cc, opp->cc_len,
744 cc_opt, "Bad CARRIAGECONTROL parameter in OPEN statement");
746 flags.share = !(cf & IOPARM_OPEN_HAS_SHARE) ? SHARE_UNSPECIFIED :
747 find_option (&opp->common, opp->share, opp->share_len,
748 share_opt, "Bad SHARE parameter in OPEN statement");
750 flags.blank = !(cf & IOPARM_OPEN_HAS_BLANK) ? BLANK_UNSPECIFIED :
751 find_option (&opp->common, opp->blank, opp->blank_len,
752 blank_opt, "Bad BLANK parameter in OPEN statement");
754 flags.delim = !(cf & IOPARM_OPEN_HAS_DELIM) ? DELIM_UNSPECIFIED :
755 find_option (&opp->common, opp->delim, opp->delim_len,
756 delim_opt, "Bad DELIM parameter in OPEN statement");
758 flags.pad = !(cf & IOPARM_OPEN_HAS_PAD) ? PAD_UNSPECIFIED :
759 find_option (&opp->common, opp->pad, opp->pad_len,
760 pad_opt, "Bad PAD parameter in OPEN statement");
762 flags.decimal = !(cf & IOPARM_OPEN_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED :
763 find_option (&opp->common, opp->decimal, opp->decimal_len,
764 decimal_opt, "Bad DECIMAL parameter in OPEN statement");
766 flags.encoding = !(cf & IOPARM_OPEN_HAS_ENCODING) ? ENCODING_UNSPECIFIED :
767 find_option (&opp->common, opp->encoding, opp->encoding_len,
768 encoding_opt, "Bad ENCODING parameter in OPEN statement");
770 flags.async = !(cf & IOPARM_OPEN_HAS_ASYNCHRONOUS) ? ASYNC_UNSPECIFIED :
771 find_option (&opp->common, opp->asynchronous, opp->asynchronous_len,
772 async_opt, "Bad ASYNCHRONOUS parameter in OPEN statement");
774 flags.round = !(cf & IOPARM_OPEN_HAS_ROUND) ? ROUND_UNSPECIFIED :
775 find_option (&opp->common, opp->round, opp->round_len,
776 round_opt, "Bad ROUND parameter in OPEN statement");
778 flags.sign = !(cf & IOPARM_OPEN_HAS_SIGN) ? SIGN_UNSPECIFIED :
779 find_option (&opp->common, opp->sign, opp->sign_len,
780 sign_opt, "Bad SIGN parameter in OPEN statement");
782 flags.form = !(cf & IOPARM_OPEN_HAS_FORM) ? FORM_UNSPECIFIED :
783 find_option (&opp->common, opp->form, opp->form_len,
784 form_opt, "Bad FORM parameter in OPEN statement");
786 flags.position = !(cf & IOPARM_OPEN_HAS_POSITION) ? POSITION_UNSPECIFIED :
787 find_option (&opp->common, opp->position, opp->position_len,
788 position_opt, "Bad POSITION parameter in OPEN statement");
790 flags.status = !(cf & IOPARM_OPEN_HAS_STATUS) ? STATUS_UNSPECIFIED :
791 find_option (&opp->common, opp->status, opp->status_len,
792 status_opt, "Bad STATUS parameter in OPEN statement");
794 /* First, we check wether the convert flag has been set via environment
795 variable. This overrides the convert tag in the open statement. */
797 conv = get_unformatted_convert (opp->common.unit);
799 if (conv == GFC_CONVERT_NONE)
801 /* Nothing has been set by environment variable, check the convert tag. */
802 if (cf & IOPARM_OPEN_HAS_CONVERT)
803 conv = find_option (&opp->common, opp->convert, opp->convert_len,
804 convert_opt,
805 "Bad CONVERT parameter in OPEN statement");
806 else
807 conv = compile_options.convert;
810 switch (conv)
812 case GFC_CONVERT_NATIVE:
813 case GFC_CONVERT_SWAP:
814 break;
816 case GFC_CONVERT_BIG:
817 conv = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP;
818 break;
820 case GFC_CONVERT_LITTLE:
821 conv = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE;
822 break;
824 default:
825 internal_error (&opp->common, "Illegal value for CONVERT");
826 break;
829 flags.convert = conv;
831 if (flags.position != POSITION_UNSPECIFIED
832 && flags.access == ACCESS_DIRECT)
833 generate_error (&opp->common, LIBERROR_BAD_OPTION,
834 "Cannot use POSITION with direct access files");
836 if (flags.readonly
837 && flags.action != ACTION_UNSPECIFIED && flags.action != ACTION_READ)
838 generate_error (&opp->common, LIBERROR_BAD_OPTION,
839 "ACTION conflicts with READONLY in OPEN statement");
841 if (flags.access == ACCESS_APPEND)
843 if (flags.position != POSITION_UNSPECIFIED
844 && flags.position != POSITION_APPEND)
845 generate_error (&opp->common, LIBERROR_BAD_OPTION,
846 "Conflicting ACCESS and POSITION flags in"
847 " OPEN statement");
849 notify_std (&opp->common, GFC_STD_GNU,
850 "Extension: APPEND as a value for ACCESS in OPEN statement");
851 flags.access = ACCESS_SEQUENTIAL;
852 flags.position = POSITION_APPEND;
855 if (flags.position == POSITION_UNSPECIFIED)
856 flags.position = POSITION_ASIS;
858 if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
860 if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT))
861 opp->common.unit = newunit_alloc ();
862 else if (opp->common.unit < 0)
864 u = find_unit (opp->common.unit);
865 if (u == NULL) /* Negative unit and no NEWUNIT-created unit found. */
867 generate_error (&opp->common, LIBERROR_BAD_OPTION,
868 "Bad unit number in OPEN statement");
869 library_end ();
870 return;
874 if (u == NULL)
875 u = find_or_create_unit (opp->common.unit);
876 if (u->s == NULL)
878 u = new_unit (opp, u, &flags);
879 if (u != NULL)
880 unlock_unit (u);
882 else
883 already_open (opp, u, &flags);
886 if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT)
887 && (opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
888 *opp->newunit = opp->common.unit;
890 library_end ();