1 /* Copyright (C) 2002-2020 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)
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/>. */
39 static const st_option access_opt
[] = {
40 {"sequential", ACCESS_SEQUENTIAL
},
41 {"direct", ACCESS_DIRECT
},
42 {"append", ACCESS_APPEND
},
43 {"stream", ACCESS_STREAM
},
47 static const st_option action_opt
[] =
49 { "read", ACTION_READ
},
50 { "write", ACTION_WRITE
},
51 { "readwrite", ACTION_READWRITE
},
55 static const st_option share_opt
[] =
57 { "denyrw", SHARE_DENYRW
},
58 { "denynone", SHARE_DENYNONE
},
62 static const st_option cc_opt
[] =
65 { "fortran", CC_FORTRAN
},
70 static const st_option blank_opt
[] =
72 { "null", BLANK_NULL
},
73 { "zero", BLANK_ZERO
},
77 static const st_option delim_opt
[] =
79 { "none", DELIM_NONE
},
80 { "apostrophe", DELIM_APOSTROPHE
},
81 { "quote", DELIM_QUOTE
},
85 static const st_option form_opt
[] =
87 { "formatted", FORM_FORMATTED
},
88 { "unformatted", FORM_UNFORMATTED
},
92 static const st_option position_opt
[] =
94 { "asis", POSITION_ASIS
},
95 { "rewind", POSITION_REWIND
},
96 { "append", POSITION_APPEND
},
100 static const st_option status_opt
[] =
102 { "unknown", STATUS_UNKNOWN
},
103 { "old", STATUS_OLD
},
104 { "new", STATUS_NEW
},
105 { "replace", STATUS_REPLACE
},
106 { "scratch", STATUS_SCRATCH
},
110 static const st_option pad_opt
[] =
117 static const st_option decimal_opt
[] =
119 { "point", DECIMAL_POINT
},
120 { "comma", DECIMAL_COMMA
},
124 static const st_option encoding_opt
[] =
126 { "utf-8", ENCODING_UTF8
},
127 { "default", ENCODING_DEFAULT
},
131 static const st_option round_opt
[] =
134 { "down", ROUND_DOWN
},
135 { "zero", ROUND_ZERO
},
136 { "nearest", ROUND_NEAREST
},
137 { "compatible", ROUND_COMPATIBLE
},
138 { "processor_defined", ROUND_PROCDEFINED
},
142 static const st_option sign_opt
[] =
144 { "plus", SIGN_PLUS
},
145 { "suppress", SIGN_SUPPRESS
},
146 { "processor_defined", SIGN_PROCDEFINED
},
150 static const st_option convert_opt
[] =
152 { "native", GFC_CONVERT_NATIVE
},
153 { "swap", GFC_CONVERT_SWAP
},
154 { "big_endian", GFC_CONVERT_BIG
},
155 { "little_endian", GFC_CONVERT_LITTLE
},
159 static const st_option async_opt
[] =
166 /* Given a unit, test to see if the file is positioned at the terminal
167 point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
168 This prevents us from changing the state from AFTER_ENDFILE to
172 test_endfile (gfc_unit
*u
)
174 if (u
->endfile
== NO_ENDFILE
)
176 gfc_offset sz
= ssize (u
->s
);
177 if (sz
== 0 || sz
== stell (u
->s
))
178 u
->endfile
= AT_ENDFILE
;
183 /* Change the modes of a file, those that are allowed * to be
187 edit_modes (st_parameter_open
*opp
, gfc_unit
*u
, unit_flags
*flags
)
189 /* Complain about attempts to change the unchangeable. */
191 if (flags
->status
!= STATUS_UNSPECIFIED
&& flags
->status
!= STATUS_OLD
&&
192 u
->flags
.status
!= flags
->status
)
193 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
194 "Cannot change STATUS parameter in OPEN statement");
196 if (flags
->access
!= ACCESS_UNSPECIFIED
&& u
->flags
.access
!= flags
->access
)
197 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
198 "Cannot change ACCESS parameter in OPEN statement");
200 if (flags
->form
!= FORM_UNSPECIFIED
&& u
->flags
.form
!= flags
->form
)
201 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
202 "Cannot change FORM parameter in OPEN statement");
204 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
)
205 && opp
->recl_in
!= u
->recl
)
206 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
207 "Cannot change RECL parameter in OPEN statement");
209 if (flags
->action
!= ACTION_UNSPECIFIED
&& u
->flags
.action
!= flags
->action
)
210 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
211 "Cannot change ACTION parameter in OPEN statement");
213 if (flags
->share
!= SHARE_UNSPECIFIED
&& u
->flags
.share
!= flags
->share
)
214 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
215 "Cannot change SHARE parameter in OPEN statement");
217 if (flags
->cc
!= CC_UNSPECIFIED
&& u
->flags
.cc
!= flags
->cc
)
218 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
219 "Cannot change CARRIAGECONTROL parameter in OPEN statement");
221 /* Status must be OLD if present. */
223 if (flags
->status
!= STATUS_UNSPECIFIED
&& flags
->status
!= STATUS_OLD
&&
224 flags
->status
!= STATUS_UNKNOWN
)
226 if (flags
->status
== STATUS_SCRATCH
)
227 notify_std (&opp
->common
, GFC_STD_GNU
,
228 "OPEN statement must have a STATUS of OLD or UNKNOWN");
230 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
231 "OPEN statement must have a STATUS of OLD or UNKNOWN");
234 if (u
->flags
.form
== FORM_UNFORMATTED
)
236 if (flags
->delim
!= DELIM_UNSPECIFIED
)
237 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
238 "DELIM parameter conflicts with UNFORMATTED form in "
241 if (flags
->blank
!= BLANK_UNSPECIFIED
)
242 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
243 "BLANK parameter conflicts with UNFORMATTED form in "
246 if (flags
->pad
!= PAD_UNSPECIFIED
)
247 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
248 "PAD parameter conflicts with UNFORMATTED form in "
251 if (flags
->decimal
!= DECIMAL_UNSPECIFIED
)
252 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
253 "DECIMAL parameter conflicts with UNFORMATTED form in "
256 if (flags
->encoding
!= ENCODING_UNSPECIFIED
)
257 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
258 "ENCODING parameter conflicts with UNFORMATTED form in "
261 if (flags
->round
!= ROUND_UNSPECIFIED
)
262 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
263 "ROUND parameter conflicts with UNFORMATTED form in "
266 if (flags
->sign
!= SIGN_UNSPECIFIED
)
267 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
268 "SIGN parameter conflicts with UNFORMATTED form in "
272 if ((opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
274 /* Change the changeable: */
275 if (flags
->blank
!= BLANK_UNSPECIFIED
)
276 u
->flags
.blank
= flags
->blank
;
277 if (flags
->delim
!= DELIM_UNSPECIFIED
)
278 u
->flags
.delim
= flags
->delim
;
279 if (flags
->pad
!= PAD_UNSPECIFIED
)
280 u
->flags
.pad
= flags
->pad
;
281 if (flags
->decimal
!= DECIMAL_UNSPECIFIED
)
282 u
->flags
.decimal
= flags
->decimal
;
283 if (flags
->encoding
!= ENCODING_UNSPECIFIED
)
284 u
->flags
.encoding
= flags
->encoding
;
285 if (flags
->async
!= ASYNC_UNSPECIFIED
)
286 u
->flags
.async
= flags
->async
;
287 if (flags
->round
!= ROUND_UNSPECIFIED
)
288 u
->flags
.round
= flags
->round
;
289 if (flags
->sign
!= SIGN_UNSPECIFIED
)
290 u
->flags
.sign
= flags
->sign
;
292 /* Reposition the file if necessary. */
294 switch (flags
->position
)
296 case POSITION_UNSPECIFIED
:
300 case POSITION_REWIND
:
301 if (sseek (u
->s
, 0, SEEK_SET
) != 0)
304 u
->current_record
= 0;
310 case POSITION_APPEND
:
311 if (sseek (u
->s
, 0, SEEK_END
) < 0)
314 if (flags
->access
!= ACCESS_STREAM
)
315 u
->current_record
= 0;
317 u
->endfile
= AT_ENDFILE
; /* We are at the end. */
321 generate_error (&opp
->common
, LIBERROR_OS
, NULL
);
330 /* Open an unused unit. */
333 new_unit (st_parameter_open
*opp
, gfc_unit
*u
, unit_flags
*flags
)
337 char tmpname
[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
339 /* Change unspecifieds to defaults. Leave (flags->action ==
340 ACTION_UNSPECIFIED) alone so open_external() can set it based on
341 what type of open actually works. */
343 if (flags
->access
== ACCESS_UNSPECIFIED
)
344 flags
->access
= ACCESS_SEQUENTIAL
;
346 if (flags
->form
== FORM_UNSPECIFIED
)
347 flags
->form
= (flags
->access
== ACCESS_SEQUENTIAL
)
348 ? FORM_FORMATTED
: FORM_UNFORMATTED
;
350 if (flags
->async
== ASYNC_UNSPECIFIED
)
351 flags
->async
= ASYNC_NO
;
353 if (flags
->status
== STATUS_UNSPECIFIED
)
354 flags
->status
= STATUS_UNKNOWN
;
356 if (flags
->cc
== CC_UNSPECIFIED
)
357 flags
->cc
= flags
->form
== FORM_UNFORMATTED
? CC_NONE
: CC_LIST
;
358 else if (flags
->form
== FORM_UNFORMATTED
&& flags
->cc
!= CC_NONE
)
360 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
361 "CARRIAGECONTROL parameter conflicts with UNFORMATTED form in "
368 if (flags
->delim
!= DELIM_UNSPECIFIED
369 && flags
->form
== FORM_UNFORMATTED
)
371 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
372 "DELIM parameter conflicts with UNFORMATTED form in "
377 if (flags
->blank
== BLANK_UNSPECIFIED
)
378 flags
->blank
= BLANK_NULL
;
381 if (flags
->form
== FORM_UNFORMATTED
)
383 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
384 "BLANK parameter conflicts with UNFORMATTED form in "
390 if (flags
->pad
== PAD_UNSPECIFIED
)
391 flags
->pad
= PAD_YES
;
394 if (flags
->form
== FORM_UNFORMATTED
)
396 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
397 "PAD parameter conflicts with UNFORMATTED form in "
403 if (flags
->decimal
== DECIMAL_UNSPECIFIED
)
404 flags
->decimal
= DECIMAL_POINT
;
407 if (flags
->form
== FORM_UNFORMATTED
)
409 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
410 "DECIMAL parameter conflicts with UNFORMATTED form "
411 "in OPEN statement");
416 if (flags
->encoding
== ENCODING_UNSPECIFIED
)
417 flags
->encoding
= ENCODING_DEFAULT
;
420 if (flags
->form
== FORM_UNFORMATTED
)
422 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
423 "ENCODING parameter conflicts with UNFORMATTED form in "
429 /* NB: the value for ROUND when it's not specified by the user does not
430 have to be PROCESSOR_DEFINED; the standard says that it is
431 processor dependent, and requires that it is one of the
432 possible value (see F2003, 9.4.5.13). */
433 if (flags
->round
== ROUND_UNSPECIFIED
)
434 flags
->round
= ROUND_PROCDEFINED
;
437 if (flags
->form
== FORM_UNFORMATTED
)
439 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
440 "ROUND parameter conflicts with UNFORMATTED form in "
446 if (flags
->sign
== SIGN_UNSPECIFIED
)
447 flags
->sign
= SIGN_PROCDEFINED
;
450 if (flags
->form
== FORM_UNFORMATTED
)
452 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
453 "SIGN parameter conflicts with UNFORMATTED form in "
459 if (flags
->position
!= POSITION_ASIS
&& flags
->access
== ACCESS_DIRECT
)
461 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
462 "ACCESS parameter conflicts with SEQUENTIAL access in "
467 if (flags
->position
== POSITION_UNSPECIFIED
)
468 flags
->position
= POSITION_ASIS
;
470 if (flags
->access
== ACCESS_DIRECT
471 && (opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
) == 0)
473 generate_error (&opp
->common
, LIBERROR_MISSING_OPTION
,
474 "Missing RECL parameter in OPEN statement");
478 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
) && opp
->recl_in
<= 0)
480 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
481 "RECL parameter is non-positive in OPEN statement");
485 switch (flags
->status
)
488 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) == 0)
494 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
495 "FILE parameter must not be present in OPEN statement");
502 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
))
506 opp
->file_len
= snprintf(opp
->file
, sizeof (tmpname
), "fort.%d",
507 (int) opp
->common
.unit
);
511 internal_error (&opp
->common
, "new_unit(): Bad status");
514 /* Make sure the file isn't already open someplace else.
515 Do not error if opening file preconnected to stdin, stdout, stderr. */
518 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) != 0
519 && !(compile_options
.allow_std
& GFC_STD_F2018
))
520 u2
= find_file (opp
->file
, opp
->file_len
);
522 && (options
.stdin_unit
< 0 || u2
->unit_number
!= options
.stdin_unit
)
523 && (options
.stdout_unit
< 0 || u2
->unit_number
!= options
.stdout_unit
)
524 && (options
.stderr_unit
< 0 || u2
->unit_number
!= options
.stderr_unit
))
527 generate_error (&opp
->common
, LIBERROR_ALREADY_OPEN
, NULL
);
534 /* If the unit specified is preconnected with a file specified to be open,
535 then clear the format buffer. */
536 if ((opp
->common
.unit
== options
.stdin_unit
||
537 opp
->common
.unit
== options
.stdout_unit
||
538 opp
->common
.unit
== options
.stderr_unit
)
539 && (opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) != 0)
544 s
= open_external (opp
, flags
);
548 char *path
= fc_strdup (opp
->file
, opp
->file_len
);
549 size_t msglen
= opp
->file_len
+ 22 + sizeof (errbuf
);
550 char *msg
= xmalloc (msglen
);
551 snprintf (msg
, msglen
, "Cannot open file '%s': %s", path
,
552 gf_strerror (errno
, errbuf
, sizeof (errbuf
)));
553 generate_error (&opp
->common
, LIBERROR_OS
, msg
);
559 if (flags
->status
== STATUS_NEW
|| flags
->status
== STATUS_REPLACE
)
560 flags
->status
= STATUS_OLD
;
562 /* Create the unit structure. */
564 if (u
->unit_number
!= opp
->common
.unit
)
565 internal_error (&opp
->common
, "Unit number changed");
569 u
->endfile
= NO_ENDFILE
;
571 u
->current_record
= 0;
577 if (flags
->position
== POSITION_APPEND
)
579 if (sseek (u
->s
, 0, SEEK_END
) < 0)
581 generate_error (&opp
->common
, LIBERROR_OS
, NULL
);
584 u
->endfile
= AT_ENDFILE
;
587 /* Unspecified recl ends up with a processor dependent value. */
589 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
))
591 u
->flags
.has_recl
= 1;
592 u
->recl
= opp
->recl_in
;
593 u
->recl_subrecord
= u
->recl
;
594 u
->bytes_left
= u
->recl
;
598 u
->flags
.has_recl
= 0;
599 u
->recl
= default_recl
;
600 if (compile_options
.max_subrecord_length
)
602 u
->recl_subrecord
= compile_options
.max_subrecord_length
;
606 switch (compile_options
.record_marker
)
610 case sizeof (GFC_INTEGER_4
):
611 u
->recl_subrecord
= GFC_MAX_SUBRECORD_LENGTH
;
614 case sizeof (GFC_INTEGER_8
):
615 u
->recl_subrecord
= max_offset
- 16;
619 runtime_error ("Illegal value for record marker");
625 /* If the file is direct access, calculate the maximum record number
626 via a division now instead of letting the multiplication overflow
629 if (flags
->access
== ACCESS_DIRECT
)
630 u
->maxrec
= max_offset
/ u
->recl
;
632 if (flags
->access
== ACCESS_STREAM
)
634 u
->maxrec
= max_offset
;
635 /* F2018 (N2137) 12.10.2.26: If the connection is for stream
636 access recl is assigned the value -2. */
639 u
->strm_pos
= stell (u
->s
) + 1;
642 u
->filename
= fc_strdup (opp
->file
, opp
->file_len
);
644 /* Curiously, the standard requires that the
645 position specifier be ignored for new files so a newly connected
646 file starts out at the initial point. We still need to figure
647 out if the file is at the end or not. */
651 if (flags
->status
== STATUS_SCRATCH
&& opp
->file
!= NULL
)
654 if (flags
->form
== FORM_FORMATTED
)
656 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
))
657 fbuf_init (u
, u
->recl
);
664 /* Check if asynchrounous. */
665 if (flags
->async
== ASYNC_YES
)
674 /* Free memory associated with a temporary filename. */
676 if (flags
->status
== STATUS_SCRATCH
&& opp
->file
!= NULL
)
686 /* Open a unit which is already open. This involves changing the
687 modes or closing what is there now and opening the new file. */
690 already_open (st_parameter_open
*opp
, gfc_unit
*u
, unit_flags
*flags
)
692 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) == 0)
694 edit_modes (opp
, u
, flags
);
698 /* If the file is connected to something else, close it and open a
701 if (!compare_file_filename (u
, opp
->file
, opp
->file_len
))
703 if (sclose (u
->s
) == -1)
706 generate_error (&opp
->common
, LIBERROR_OS
,
707 "Error closing file in OPEN statement");
713 #if !HAVE_UNLINK_OPEN_FILE
714 if (u
->filename
&& u
->flags
.status
== STATUS_SCRATCH
)
715 remove (u
->filename
);
720 u
= new_unit (opp
, u
, flags
);
726 edit_modes (opp
, u
, flags
);
732 extern void st_open (st_parameter_open
*opp
);
733 export_proto(st_open
);
736 st_open (st_parameter_open
*opp
)
740 GFC_INTEGER_4 cf
= opp
->common
.flags
;
743 library_start (&opp
->common
);
745 /* Decode options. */
746 flags
.readonly
= !(cf
& IOPARM_OPEN_HAS_READONLY
) ? 0 : opp
->readonly
;
748 flags
.access
= !(cf
& IOPARM_OPEN_HAS_ACCESS
) ? ACCESS_UNSPECIFIED
:
749 find_option (&opp
->common
, opp
->access
, opp
->access_len
,
750 access_opt
, "Bad ACCESS parameter in OPEN statement");
752 flags
.action
= !(cf
& IOPARM_OPEN_HAS_ACTION
) ? ACTION_UNSPECIFIED
:
753 find_option (&opp
->common
, opp
->action
, opp
->action_len
,
754 action_opt
, "Bad ACTION parameter in OPEN statement");
756 flags
.cc
= !(cf
& IOPARM_OPEN_HAS_CC
) ? CC_UNSPECIFIED
:
757 find_option (&opp
->common
, opp
->cc
, opp
->cc_len
,
758 cc_opt
, "Bad CARRIAGECONTROL parameter in OPEN statement");
760 flags
.share
= !(cf
& IOPARM_OPEN_HAS_SHARE
) ? SHARE_UNSPECIFIED
:
761 find_option (&opp
->common
, opp
->share
, opp
->share_len
,
762 share_opt
, "Bad SHARE parameter in OPEN statement");
764 flags
.blank
= !(cf
& IOPARM_OPEN_HAS_BLANK
) ? BLANK_UNSPECIFIED
:
765 find_option (&opp
->common
, opp
->blank
, opp
->blank_len
,
766 blank_opt
, "Bad BLANK parameter in OPEN statement");
768 flags
.delim
= !(cf
& IOPARM_OPEN_HAS_DELIM
) ? DELIM_UNSPECIFIED
:
769 find_option (&opp
->common
, opp
->delim
, opp
->delim_len
,
770 delim_opt
, "Bad DELIM parameter in OPEN statement");
772 flags
.pad
= !(cf
& IOPARM_OPEN_HAS_PAD
) ? PAD_UNSPECIFIED
:
773 find_option (&opp
->common
, opp
->pad
, opp
->pad_len
,
774 pad_opt
, "Bad PAD parameter in OPEN statement");
776 flags
.decimal
= !(cf
& IOPARM_OPEN_HAS_DECIMAL
) ? DECIMAL_UNSPECIFIED
:
777 find_option (&opp
->common
, opp
->decimal
, opp
->decimal_len
,
778 decimal_opt
, "Bad DECIMAL parameter in OPEN statement");
780 flags
.encoding
= !(cf
& IOPARM_OPEN_HAS_ENCODING
) ? ENCODING_UNSPECIFIED
:
781 find_option (&opp
->common
, opp
->encoding
, opp
->encoding_len
,
782 encoding_opt
, "Bad ENCODING parameter in OPEN statement");
784 flags
.async
= !(cf
& IOPARM_OPEN_HAS_ASYNCHRONOUS
) ? ASYNC_UNSPECIFIED
:
785 find_option (&opp
->common
, opp
->asynchronous
, opp
->asynchronous_len
,
786 async_opt
, "Bad ASYNCHRONOUS parameter in OPEN statement");
788 flags
.round
= !(cf
& IOPARM_OPEN_HAS_ROUND
) ? ROUND_UNSPECIFIED
:
789 find_option (&opp
->common
, opp
->round
, opp
->round_len
,
790 round_opt
, "Bad ROUND parameter in OPEN statement");
792 flags
.sign
= !(cf
& IOPARM_OPEN_HAS_SIGN
) ? SIGN_UNSPECIFIED
:
793 find_option (&opp
->common
, opp
->sign
, opp
->sign_len
,
794 sign_opt
, "Bad SIGN parameter in OPEN statement");
796 flags
.form
= !(cf
& IOPARM_OPEN_HAS_FORM
) ? FORM_UNSPECIFIED
:
797 find_option (&opp
->common
, opp
->form
, opp
->form_len
,
798 form_opt
, "Bad FORM parameter in OPEN statement");
800 flags
.position
= !(cf
& IOPARM_OPEN_HAS_POSITION
) ? POSITION_UNSPECIFIED
:
801 find_option (&opp
->common
, opp
->position
, opp
->position_len
,
802 position_opt
, "Bad POSITION parameter in OPEN statement");
804 flags
.status
= !(cf
& IOPARM_OPEN_HAS_STATUS
) ? STATUS_UNSPECIFIED
:
805 find_option (&opp
->common
, opp
->status
, opp
->status_len
,
806 status_opt
, "Bad STATUS parameter in OPEN statement");
808 /* First, we check wether the convert flag has been set via environment
809 variable. This overrides the convert tag in the open statement. */
811 conv
= get_unformatted_convert (opp
->common
.unit
);
813 if (conv
== GFC_CONVERT_NONE
)
815 /* Nothing has been set by environment variable, check the convert tag. */
816 if (cf
& IOPARM_OPEN_HAS_CONVERT
)
817 conv
= find_option (&opp
->common
, opp
->convert
, opp
->convert_len
,
819 "Bad CONVERT parameter in OPEN statement");
821 conv
= compile_options
.convert
;
826 case GFC_CONVERT_NATIVE
:
827 case GFC_CONVERT_SWAP
:
830 case GFC_CONVERT_BIG
:
831 conv
= __BYTE_ORDER__
== __ORDER_BIG_ENDIAN__
? GFC_CONVERT_NATIVE
: GFC_CONVERT_SWAP
;
834 case GFC_CONVERT_LITTLE
:
835 conv
= __BYTE_ORDER__
== __ORDER_BIG_ENDIAN__
? GFC_CONVERT_SWAP
: GFC_CONVERT_NATIVE
;
839 internal_error (&opp
->common
, "Illegal value for CONVERT");
843 flags
.convert
= conv
;
845 if (flags
.position
!= POSITION_UNSPECIFIED
846 && flags
.access
== ACCESS_DIRECT
)
847 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
848 "Cannot use POSITION with direct access files");
851 && flags
.action
!= ACTION_UNSPECIFIED
&& flags
.action
!= ACTION_READ
)
852 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
853 "ACTION conflicts with READONLY in OPEN statement");
855 if (flags
.access
== ACCESS_APPEND
)
857 if (flags
.position
!= POSITION_UNSPECIFIED
858 && flags
.position
!= POSITION_APPEND
)
859 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
860 "Conflicting ACCESS and POSITION flags in"
863 notify_std (&opp
->common
, GFC_STD_GNU
,
864 "Extension: APPEND as a value for ACCESS in OPEN statement");
865 flags
.access
= ACCESS_SEQUENTIAL
;
866 flags
.position
= POSITION_APPEND
;
869 if (flags
.position
== POSITION_UNSPECIFIED
)
870 flags
.position
= POSITION_ASIS
;
872 if ((opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
874 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_NEWUNIT
))
875 opp
->common
.unit
= newunit_alloc ();
876 else if (opp
->common
.unit
< 0)
878 u
= find_unit (opp
->common
.unit
);
879 if (u
== NULL
) /* Negative unit and no NEWUNIT-created unit found. */
881 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
882 "Bad unit number in OPEN statement");
889 u
= find_or_create_unit (opp
->common
.unit
);
892 u
= new_unit (opp
, u
, &flags
);
897 already_open (opp
, u
, &flags
);
900 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_NEWUNIT
)
901 && (opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
902 *opp
->newunit
= opp
->common
.unit
;