]>
Commit | Line | Data |
---|---|---|
99dee823 | 1 | /* Copyright (C) 2002-2021 Free Software Foundation, Inc. |
6de9cd9a | 2 | Contributed by Andy Vaught |
10256cbe | 3 | F2003 I/O support contributed by Jerry DeLisle |
6de9cd9a | 4 | |
bb408e87 | 5 | This file is part of the GNU Fortran runtime library (libgfortran). |
6de9cd9a DN |
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 | |
748086b7 | 9 | the Free Software Foundation; either version 3, or (at your option) |
6de9cd9a DN |
10 | any later version. |
11 | ||
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. | |
16 | ||
748086b7 JJ |
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. | |
20 | ||
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/>. */ | |
6de9cd9a | 25 | |
36ae8a61 | 26 | #include "io.h" |
92cbdb68 JB |
27 | #include "fbuf.h" |
28 | #include "unix.h" | |
2b4c9065 | 29 | #include "async.h" |
19f0e98f DE |
30 | |
31 | #ifdef HAVE_UNISTD_H | |
6de9cd9a | 32 | #include <unistd.h> |
19f0e98f DE |
33 | #endif |
34 | ||
6de9cd9a | 35 | #include <string.h> |
db7317c3 | 36 | #include <errno.h> |
6de9cd9a DN |
37 | |
38 | ||
09003779 | 39 | static const st_option access_opt[] = { |
6de9cd9a DN |
40 | {"sequential", ACCESS_SEQUENTIAL}, |
41 | {"direct", ACCESS_DIRECT}, | |
1c2e7a3a | 42 | {"append", ACCESS_APPEND}, |
91b30ee5 | 43 | {"stream", ACCESS_STREAM}, |
8f2a1406 | 44 | {NULL, 0} |
f21edfd6 RH |
45 | }; |
46 | ||
09003779 | 47 | static const st_option action_opt[] = |
6de9cd9a | 48 | { |
f21edfd6 RH |
49 | { "read", ACTION_READ}, |
50 | { "write", ACTION_WRITE}, | |
51 | { "readwrite", ACTION_READWRITE}, | |
8f2a1406 | 52 | { NULL, 0} |
f21edfd6 | 53 | }; |
6de9cd9a | 54 | |
0ef33d44 FR |
55 | static const st_option share_opt[] = |
56 | { | |
57 | { "denyrw", SHARE_DENYRW }, | |
58 | { "denynone", SHARE_DENYNONE }, | |
59 | { NULL, 0} | |
60 | }; | |
61 | ||
62 | static const st_option cc_opt[] = | |
63 | { | |
64 | { "list", CC_LIST }, | |
65 | { "fortran", CC_FORTRAN }, | |
66 | { "none", CC_NONE }, | |
67 | { NULL, 0} | |
68 | }; | |
69 | ||
09003779 | 70 | static const st_option blank_opt[] = |
6de9cd9a | 71 | { |
f21edfd6 RH |
72 | { "null", BLANK_NULL}, |
73 | { "zero", BLANK_ZERO}, | |
8f2a1406 | 74 | { NULL, 0} |
f21edfd6 | 75 | }; |
6de9cd9a | 76 | |
09003779 | 77 | static const st_option delim_opt[] = |
6de9cd9a | 78 | { |
f21edfd6 RH |
79 | { "none", DELIM_NONE}, |
80 | { "apostrophe", DELIM_APOSTROPHE}, | |
81 | { "quote", DELIM_QUOTE}, | |
8f2a1406 | 82 | { NULL, 0} |
f21edfd6 | 83 | }; |
6de9cd9a | 84 | |
09003779 | 85 | static const st_option form_opt[] = |
6de9cd9a | 86 | { |
f21edfd6 RH |
87 | { "formatted", FORM_FORMATTED}, |
88 | { "unformatted", FORM_UNFORMATTED}, | |
8f2a1406 | 89 | { NULL, 0} |
f21edfd6 | 90 | }; |
6de9cd9a | 91 | |
09003779 | 92 | static const st_option position_opt[] = |
6de9cd9a | 93 | { |
f21edfd6 RH |
94 | { "asis", POSITION_ASIS}, |
95 | { "rewind", POSITION_REWIND}, | |
96 | { "append", POSITION_APPEND}, | |
8f2a1406 | 97 | { NULL, 0} |
f21edfd6 | 98 | }; |
6de9cd9a | 99 | |
09003779 | 100 | static const st_option status_opt[] = |
6de9cd9a | 101 | { |
f21edfd6 RH |
102 | { "unknown", STATUS_UNKNOWN}, |
103 | { "old", STATUS_OLD}, | |
104 | { "new", STATUS_NEW}, | |
105 | { "replace", STATUS_REPLACE}, | |
106 | { "scratch", STATUS_SCRATCH}, | |
8f2a1406 | 107 | { NULL, 0} |
f21edfd6 | 108 | }; |
6de9cd9a | 109 | |
09003779 | 110 | static const st_option pad_opt[] = |
6de9cd9a | 111 | { |
f21edfd6 RH |
112 | { "yes", PAD_YES}, |
113 | { "no", PAD_NO}, | |
8f2a1406 | 114 | { NULL, 0} |
6de9cd9a DN |
115 | }; |
116 | ||
10256cbe JD |
117 | static const st_option decimal_opt[] = |
118 | { | |
119 | { "point", DECIMAL_POINT}, | |
120 | { "comma", DECIMAL_COMMA}, | |
121 | { NULL, 0} | |
122 | }; | |
123 | ||
124 | static const st_option encoding_opt[] = | |
125 | { | |
cea93abb | 126 | { "utf-8", ENCODING_UTF8}, |
10256cbe JD |
127 | { "default", ENCODING_DEFAULT}, |
128 | { NULL, 0} | |
129 | }; | |
130 | ||
131 | static const st_option round_opt[] = | |
132 | { | |
133 | { "up", ROUND_UP}, | |
134 | { "down", ROUND_DOWN}, | |
135 | { "zero", ROUND_ZERO}, | |
136 | { "nearest", ROUND_NEAREST}, | |
137 | { "compatible", ROUND_COMPATIBLE}, | |
138 | { "processor_defined", ROUND_PROCDEFINED}, | |
139 | { NULL, 0} | |
140 | }; | |
141 | ||
142 | static const st_option sign_opt[] = | |
143 | { | |
144 | { "plus", SIGN_PLUS}, | |
145 | { "suppress", SIGN_SUPPRESS}, | |
146 | { "processor_defined", SIGN_PROCDEFINED}, | |
147 | { NULL, 0} | |
148 | }; | |
149 | ||
181c9f4a TK |
150 | static const st_option convert_opt[] = |
151 | { | |
d74b97cc FXC |
152 | { "native", GFC_CONVERT_NATIVE}, |
153 | { "swap", GFC_CONVERT_SWAP}, | |
154 | { "big_endian", GFC_CONVERT_BIG}, | |
155 | { "little_endian", GFC_CONVERT_LITTLE}, | |
181c9f4a TK |
156 | { NULL, 0} |
157 | }; | |
6de9cd9a | 158 | |
10256cbe JD |
159 | static const st_option async_opt[] = |
160 | { | |
161 | { "yes", ASYNC_YES}, | |
162 | { "no", ASYNC_NO}, | |
163 | { NULL, 0} | |
164 | }; | |
b4501dfd JD |
165 | |
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 | |
169 | AT_ENDFILE. */ | |
170 | ||
171 | static void | |
f29876bb | 172 | test_endfile (gfc_unit *u) |
b4501dfd | 173 | { |
68aab0e2 JB |
174 | if (u->endfile == NO_ENDFILE) |
175 | { | |
176 | gfc_offset sz = ssize (u->s); | |
177 | if (sz == 0 || sz == stell (u->s)) | |
178 | u->endfile = AT_ENDFILE; | |
179 | } | |
b4501dfd JD |
180 | } |
181 | ||
182 | ||
7fcb1804 TS |
183 | /* Change the modes of a file, those that are allowed * to be |
184 | changed. */ | |
6de9cd9a DN |
185 | |
186 | static void | |
f29876bb | 187 | edit_modes (st_parameter_open *opp, gfc_unit *u, unit_flags *flags) |
6de9cd9a | 188 | { |
7fcb1804 | 189 | /* Complain about attempts to change the unchangeable. */ |
6de9cd9a | 190 | |
2e444427 | 191 | if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD && |
21905d1b | 192 | u->flags.status != flags->status) |
d74b97cc | 193 | generate_error (&opp->common, LIBERROR_BAD_OPTION, |
6de9cd9a DN |
194 | "Cannot change STATUS parameter in OPEN statement"); |
195 | ||
196 | if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access) | |
d74b97cc | 197 | generate_error (&opp->common, LIBERROR_BAD_OPTION, |
6de9cd9a DN |
198 | "Cannot change ACCESS parameter in OPEN statement"); |
199 | ||
200 | if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form) | |
d74b97cc | 201 | generate_error (&opp->common, LIBERROR_BAD_OPTION, |
6de9cd9a DN |
202 | "Cannot change FORM parameter in OPEN statement"); |
203 | ||
5e805e44 JJ |
204 | if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) |
205 | && opp->recl_in != u->recl) | |
d74b97cc | 206 | generate_error (&opp->common, LIBERROR_BAD_OPTION, |
6de9cd9a DN |
207 | "Cannot change RECL parameter in OPEN statement"); |
208 | ||
c05f6d04 | 209 | if (flags->action != ACTION_UNSPECIFIED && u->flags.action != flags->action) |
d74b97cc | 210 | generate_error (&opp->common, LIBERROR_BAD_OPTION, |
6de9cd9a DN |
211 | "Cannot change ACTION parameter in OPEN statement"); |
212 | ||
0ef33d44 FR |
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"); | |
216 | ||
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"); | |
220 | ||
7fcb1804 | 221 | /* Status must be OLD if present. */ |
6de9cd9a | 222 | |
cea51b42 JB |
223 | if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD && |
224 | flags->status != STATUS_UNKNOWN) | |
2e444427 JD |
225 | { |
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"); | |
229 | else | |
d74b97cc | 230 | generate_error (&opp->common, LIBERROR_BAD_OPTION, |
cea51b42 | 231 | "OPEN statement must have a STATUS of OLD or UNKNOWN"); |
2e444427 | 232 | } |
6de9cd9a DN |
233 | |
234 | if (u->flags.form == FORM_UNFORMATTED) | |
235 | { | |
236 | if (flags->delim != DELIM_UNSPECIFIED) | |
d74b97cc | 237 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, |
6de9cd9a DN |
238 | "DELIM parameter conflicts with UNFORMATTED form in " |
239 | "OPEN statement"); | |
240 | ||
241 | if (flags->blank != BLANK_UNSPECIFIED) | |
d74b97cc | 242 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, |
6de9cd9a DN |
243 | "BLANK parameter conflicts with UNFORMATTED form in " |
244 | "OPEN statement"); | |
245 | ||
246 | if (flags->pad != PAD_UNSPECIFIED) | |
d74b97cc | 247 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, |
8b6dba81 | 248 | "PAD parameter conflicts with UNFORMATTED form in " |
6de9cd9a | 249 | "OPEN statement"); |
10256cbe JD |
250 | |
251 | if (flags->decimal != DECIMAL_UNSPECIFIED) | |
252 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, | |
253 | "DECIMAL parameter conflicts with UNFORMATTED form in " | |
254 | "OPEN statement"); | |
255 | ||
256 | if (flags->encoding != ENCODING_UNSPECIFIED) | |
257 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, | |
258 | "ENCODING parameter conflicts with UNFORMATTED form in " | |
259 | "OPEN statement"); | |
260 | ||
261 | if (flags->round != ROUND_UNSPECIFIED) | |
262 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, | |
263 | "ROUND parameter conflicts with UNFORMATTED form in " | |
264 | "OPEN statement"); | |
265 | ||
266 | if (flags->sign != SIGN_UNSPECIFIED) | |
267 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, | |
268 | "SIGN parameter conflicts with UNFORMATTED form in " | |
269 | "OPEN statement"); | |
6de9cd9a DN |
270 | } |
271 | ||
5e805e44 | 272 | if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK) |
7fcb1804 TS |
273 | { |
274 | /* Change the changeable: */ | |
6de9cd9a DN |
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; | |
10256cbe JD |
281 | if (flags->decimal != DECIMAL_UNSPECIFIED) |
282 | u->flags.decimal = flags->decimal; | |
283 | if (flags->encoding != ENCODING_UNSPECIFIED) | |
284 | u->flags.encoding = flags->encoding; | |
931149a6 JD |
285 | if (flags->async != ASYNC_UNSPECIFIED) |
286 | u->flags.async = flags->async; | |
10256cbe JD |
287 | if (flags->round != ROUND_UNSPECIFIED) |
288 | u->flags.round = flags->round; | |
289 | if (flags->sign != SIGN_UNSPECIFIED) | |
290 | u->flags.sign = flags->sign; | |
6de9cd9a | 291 | |
1ede59e4 JD |
292 | /* Reposition the file if necessary. */ |
293 | ||
294 | switch (flags->position) | |
295 | { | |
296 | case POSITION_UNSPECIFIED: | |
297 | case POSITION_ASIS: | |
298 | break; | |
299 | ||
300 | case POSITION_REWIND: | |
301 | if (sseek (u->s, 0, SEEK_SET) != 0) | |
302 | goto seek_error; | |
303 | ||
304 | u->current_record = 0; | |
305 | u->last_record = 0; | |
306 | ||
307 | test_endfile (u); | |
308 | break; | |
309 | ||
310 | case POSITION_APPEND: | |
311 | if (sseek (u->s, 0, SEEK_END) < 0) | |
312 | goto seek_error; | |
313 | ||
314 | if (flags->access != ACCESS_STREAM) | |
315 | u->current_record = 0; | |
316 | ||
317 | u->endfile = AT_ENDFILE; /* We are at the end. */ | |
318 | break; | |
319 | ||
320 | seek_error: | |
321 | generate_error (&opp->common, LIBERROR_OS, NULL); | |
322 | break; | |
323 | } | |
6de9cd9a | 324 | } |
5e805e44 JJ |
325 | |
326 | unlock_unit (u); | |
6de9cd9a DN |
327 | } |
328 | ||
329 | ||
7fcb1804 | 330 | /* Open an unused unit. */ |
6de9cd9a | 331 | |
5e805e44 | 332 | gfc_unit * |
f29876bb | 333 | new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags *flags) |
6de9cd9a | 334 | { |
5e805e44 | 335 | gfc_unit *u2; |
6de9cd9a DN |
336 | stream *s; |
337 | char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */]; | |
338 | ||
6ecf6dcb SE |
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. */ | |
6de9cd9a DN |
342 | |
343 | if (flags->access == ACCESS_UNSPECIFIED) | |
344 | flags->access = ACCESS_SEQUENTIAL; | |
345 | ||
6de9cd9a DN |
346 | if (flags->form == FORM_UNSPECIFIED) |
347 | flags->form = (flags->access == ACCESS_SEQUENTIAL) | |
348 | ? FORM_FORMATTED : FORM_UNFORMATTED; | |
349 | ||
931149a6 JD |
350 | if (flags->async == ASYNC_UNSPECIFIED) |
351 | flags->async = ASYNC_NO; | |
352 | ||
353 | if (flags->status == STATUS_UNSPECIFIED) | |
354 | flags->status = STATUS_UNKNOWN; | |
355 | ||
0ef33d44 FR |
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) | |
359 | { | |
360 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, | |
361 | "CARRIAGECONTROL parameter conflicts with UNFORMATTED form in " | |
362 | "OPEN statement"); | |
363 | goto fail; | |
364 | } | |
365 | ||
931149a6 | 366 | /* Checks. */ |
6de9cd9a | 367 | |
75b2dba9 JD |
368 | if (flags->delim != DELIM_UNSPECIFIED |
369 | && flags->form == FORM_UNFORMATTED) | |
6de9cd9a | 370 | { |
75b2dba9 JD |
371 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, |
372 | "DELIM parameter conflicts with UNFORMATTED form in " | |
373 | "OPEN statement"); | |
374 | goto fail; | |
6de9cd9a DN |
375 | } |
376 | ||
377 | if (flags->blank == BLANK_UNSPECIFIED) | |
378 | flags->blank = BLANK_NULL; | |
379 | else | |
380 | { | |
381 | if (flags->form == FORM_UNFORMATTED) | |
382 | { | |
d74b97cc | 383 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, |
6de9cd9a DN |
384 | "BLANK parameter conflicts with UNFORMATTED form in " |
385 | "OPEN statement"); | |
5e805e44 | 386 | goto fail; |
6de9cd9a DN |
387 | } |
388 | } | |
389 | ||
390 | if (flags->pad == PAD_UNSPECIFIED) | |
391 | flags->pad = PAD_YES; | |
392 | else | |
393 | { | |
394 | if (flags->form == FORM_UNFORMATTED) | |
395 | { | |
d74b97cc | 396 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, |
8b6dba81 | 397 | "PAD parameter conflicts with UNFORMATTED form in " |
6de9cd9a | 398 | "OPEN statement"); |
5e805e44 | 399 | goto fail; |
6de9cd9a DN |
400 | } |
401 | } | |
402 | ||
10256cbe JD |
403 | if (flags->decimal == DECIMAL_UNSPECIFIED) |
404 | flags->decimal = DECIMAL_POINT; | |
405 | else | |
406 | { | |
407 | if (flags->form == FORM_UNFORMATTED) | |
408 | { | |
409 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, | |
410 | "DECIMAL parameter conflicts with UNFORMATTED form " | |
411 | "in OPEN statement"); | |
412 | goto fail; | |
413 | } | |
414 | } | |
415 | ||
416 | if (flags->encoding == ENCODING_UNSPECIFIED) | |
417 | flags->encoding = ENCODING_DEFAULT; | |
418 | else | |
419 | { | |
420 | if (flags->form == FORM_UNFORMATTED) | |
421 | { | |
422 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, | |
423 | "ENCODING parameter conflicts with UNFORMATTED form in " | |
424 | "OPEN statement"); | |
425 | goto fail; | |
426 | } | |
427 | } | |
428 | ||
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; | |
435 | else | |
436 | { | |
437 | if (flags->form == FORM_UNFORMATTED) | |
438 | { | |
439 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, | |
440 | "ROUND parameter conflicts with UNFORMATTED form in " | |
441 | "OPEN statement"); | |
442 | goto fail; | |
443 | } | |
444 | } | |
445 | ||
446 | if (flags->sign == SIGN_UNSPECIFIED) | |
447 | flags->sign = SIGN_PROCDEFINED; | |
448 | else | |
449 | { | |
450 | if (flags->form == FORM_UNFORMATTED) | |
451 | { | |
452 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, | |
453 | "SIGN parameter conflicts with UNFORMATTED form in " | |
454 | "OPEN statement"); | |
455 | goto fail; | |
456 | } | |
457 | } | |
458 | ||
6de9cd9a DN |
459 | if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT) |
460 | { | |
d74b97cc | 461 | generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, |
6de9cd9a DN |
462 | "ACCESS parameter conflicts with SEQUENTIAL access in " |
463 | "OPEN statement"); | |
5e805e44 | 464 | goto fail; |
6de9cd9a DN |
465 | } |
466 | else | |
467 | if (flags->position == POSITION_UNSPECIFIED) | |
468 | flags->position = POSITION_ASIS; | |
469 | ||
5e805e44 JJ |
470 | if (flags->access == ACCESS_DIRECT |
471 | && (opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) == 0) | |
6de9cd9a | 472 | { |
d74b97cc | 473 | generate_error (&opp->common, LIBERROR_MISSING_OPTION, |
6de9cd9a | 474 | "Missing RECL parameter in OPEN statement"); |
5e805e44 | 475 | goto fail; |
6de9cd9a DN |
476 | } |
477 | ||
5e805e44 | 478 | if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) && opp->recl_in <= 0) |
6de9cd9a | 479 | { |
d74b97cc | 480 | generate_error (&opp->common, LIBERROR_BAD_OPTION, |
6de9cd9a | 481 | "RECL parameter is non-positive in OPEN statement"); |
5e805e44 | 482 | goto fail; |
6de9cd9a DN |
483 | } |
484 | ||
485 | switch (flags->status) | |
486 | { | |
487 | case STATUS_SCRATCH: | |
5e805e44 JJ |
488 | if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0) |
489 | { | |
490 | opp->file = NULL; | |
491 | break; | |
492 | } | |
6de9cd9a | 493 | |
d74b97cc | 494 | generate_error (&opp->common, LIBERROR_BAD_OPTION, |
6de9cd9a | 495 | "FILE parameter must not be present in OPEN statement"); |
5e805e44 | 496 | goto fail; |
6de9cd9a DN |
497 | |
498 | case STATUS_OLD: | |
499 | case STATUS_NEW: | |
500 | case STATUS_REPLACE: | |
501 | case STATUS_UNKNOWN: | |
5e805e44 | 502 | if ((opp->common.flags & IOPARM_OPEN_HAS_FILE)) |
6de9cd9a DN |
503 | break; |
504 | ||
5e805e44 | 505 | opp->file = tmpname; |
88fdfd5a JB |
506 | opp->file_len = snprintf(opp->file, sizeof (tmpname), "fort.%d", |
507 | (int) opp->common.unit); | |
6de9cd9a DN |
508 | break; |
509 | ||
510 | default: | |
5e805e44 | 511 | internal_error (&opp->common, "new_unit(): Bad status"); |
6de9cd9a DN |
512 | } |
513 | ||
fbac3363 DE |
514 | /* Make sure the file isn't already open someplace else. |
515 | Do not error if opening file preconnected to stdin, stdout, stderr. */ | |
516 | ||
5e805e44 | 517 | u2 = NULL; |
0c15ebf1 JB |
518 | if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) != 0 |
519 | && !(compile_options.allow_std & GFC_STD_F2018)) | |
5e805e44 JJ |
520 | u2 = find_file (opp->file, opp->file_len); |
521 | if (u2 != NULL | |
1ed1c7ce AM |
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)) | |
6de9cd9a | 525 | { |
5e805e44 | 526 | unlock_unit (u2); |
d74b97cc | 527 | generate_error (&opp->common, LIBERROR_ALREADY_OPEN, NULL); |
6de9cd9a DN |
528 | goto cleanup; |
529 | } | |
530 | ||
5e805e44 JJ |
531 | if (u2 != NULL) |
532 | unlock_unit (u2); | |
533 | ||
9c5f8900 JD |
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) | |
540 | fbuf_destroy (u); | |
541 | ||
7fcb1804 | 542 | /* Open file. */ |
6de9cd9a | 543 | |
5e805e44 | 544 | s = open_external (opp, flags); |
6de9cd9a DN |
545 | if (s == NULL) |
546 | { | |
6234b543 | 547 | char errbuf[256]; |
4269f19c | 548 | char *path = fc_strdup (opp->file, opp->file_len); |
6234b543 | 549 | size_t msglen = opp->file_len + 22 + sizeof (errbuf); |
4269f19c | 550 | char *msg = xmalloc (msglen); |
6234b543 JB |
551 | snprintf (msg, msglen, "Cannot open file '%s': %s", path, |
552 | gf_strerror (errno, errbuf, sizeof (errbuf))); | |
d74b97cc | 553 | generate_error (&opp->common, LIBERROR_OS, msg); |
4269f19c JB |
554 | free (msg); |
555 | free (path); | |
6de9cd9a DN |
556 | goto cleanup; |
557 | } | |
558 | ||
559 | if (flags->status == STATUS_NEW || flags->status == STATUS_REPLACE) | |
560 | flags->status = STATUS_OLD; | |
561 | ||
7fcb1804 | 562 | /* Create the unit structure. */ |
6de9cd9a | 563 | |
5e805e44 JJ |
564 | if (u->unit_number != opp->common.unit) |
565 | internal_error (&opp->common, "Unit number changed"); | |
6de9cd9a DN |
566 | u->s = s; |
567 | u->flags = *flags; | |
5e805e44 JJ |
568 | u->read_bad = 0; |
569 | u->endfile = NO_ENDFILE; | |
570 | u->last_record = 0; | |
571 | u->current_record = 0; | |
572 | u->mode = READING; | |
573 | u->maxrec = 0; | |
574 | u->bytes_left = 0; | |
beb6a65e | 575 | u->saved_pos = 0; |
6de9cd9a | 576 | |
da32fddc | 577 | if (flags->position == POSITION_APPEND) |
5e805e44 | 578 | { |
0948d153 | 579 | if (sseek (u->s, 0, SEEK_END) < 0) |
1ede59e4 JD |
580 | { |
581 | generate_error (&opp->common, LIBERROR_OS, NULL); | |
582 | goto cleanup; | |
583 | } | |
5e805e44 JJ |
584 | u->endfile = AT_ENDFILE; |
585 | } | |
da32fddc | 586 | |
7fcb1804 | 587 | /* Unspecified recl ends up with a processor dependent value. */ |
6de9cd9a | 588 | |
5e805e44 | 589 | if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN)) |
b0c6db58 JD |
590 | { |
591 | u->flags.has_recl = 1; | |
592 | u->recl = opp->recl_in; | |
f4072316 JD |
593 | u->recl_subrecord = u->recl; |
594 | u->bytes_left = u->recl; | |
b0c6db58 | 595 | } |
5e805e44 | 596 | else |
d67ab5ee | 597 | { |
b0c6db58 | 598 | u->flags.has_recl = 0; |
67c24a8b | 599 | u->recl = default_recl; |
07b3bbf2 | 600 | if (compile_options.max_subrecord_length) |
d67ab5ee | 601 | { |
07b3bbf2 TK |
602 | u->recl_subrecord = compile_options.max_subrecord_length; |
603 | } | |
604 | else | |
605 | { | |
606 | switch (compile_options.record_marker) | |
607 | { | |
608 | case 0: | |
609 | /* Fall through */ | |
610 | case sizeof (GFC_INTEGER_4): | |
611 | u->recl_subrecord = GFC_MAX_SUBRECORD_LENGTH; | |
612 | break; | |
613 | ||
614 | case sizeof (GFC_INTEGER_8): | |
615 | u->recl_subrecord = max_offset - 16; | |
616 | break; | |
617 | ||
618 | default: | |
619 | runtime_error ("Illegal value for record marker"); | |
620 | break; | |
621 | } | |
d67ab5ee TK |
622 | } |
623 | } | |
6de9cd9a DN |
624 | |
625 | /* If the file is direct access, calculate the maximum record number | |
7fcb1804 TS |
626 | via a division now instead of letting the multiplication overflow |
627 | later. */ | |
6de9cd9a DN |
628 | |
629 | if (flags->access == ACCESS_DIRECT) | |
5e805e44 | 630 | u->maxrec = max_offset / u->recl; |
91b30ee5 JD |
631 | |
632 | if (flags->access == ACCESS_STREAM) | |
633 | { | |
634 | u->maxrec = max_offset; | |
67c24a8b JB |
635 | /* F2018 (N2137) 12.10.2.26: If the connection is for stream |
636 | access recl is assigned the value -2. */ | |
637 | u->recl = -2; | |
7812c78c JD |
638 | u->bytes_left = 1; |
639 | u->strm_pos = stell (u->s) + 1; | |
91b30ee5 | 640 | } |
6de9cd9a | 641 | |
0e05c303 | 642 | u->filename = fc_strdup (opp->file, opp->file_len); |
6de9cd9a | 643 | |
b4501dfd JD |
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. */ | |
648 | ||
649 | test_endfile (u); | |
650 | ||
5e805e44 | 651 | if (flags->status == STATUS_SCRATCH && opp->file != NULL) |
bb408e87 | 652 | free (opp->file); |
15877a88 | 653 | |
7812c78c | 654 | if (flags->form == FORM_FORMATTED) |
8947fd62 JB |
655 | { |
656 | if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN)) | |
657 | fbuf_init (u, u->recl); | |
658 | else | |
659 | fbuf_init (u, 0); | |
660 | } | |
15877a88 JB |
661 | else |
662 | u->fbuf = NULL; | |
8947fd62 | 663 | |
2b4c9065 NK |
664 | /* Check if asynchrounous. */ |
665 | if (flags->async == ASYNC_YES) | |
666 | init_async_unit (u); | |
667 | else | |
668 | u->au = NULL; | |
669 | ||
5e805e44 JJ |
670 | return u; |
671 | ||
f21edfd6 | 672 | cleanup: |
6de9cd9a | 673 | |
7fcb1804 | 674 | /* Free memory associated with a temporary filename. */ |
6de9cd9a | 675 | |
5e805e44 | 676 | if (flags->status == STATUS_SCRATCH && opp->file != NULL) |
bb408e87 | 677 | free (opp->file); |
5e805e44 JJ |
678 | |
679 | fail: | |
680 | ||
681 | close_unit (u); | |
682 | return NULL; | |
6de9cd9a DN |
683 | } |
684 | ||
685 | ||
7fcb1804 TS |
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. */ | |
6de9cd9a DN |
688 | |
689 | static void | |
f29876bb | 690 | already_open (st_parameter_open *opp, gfc_unit *u, unit_flags *flags) |
6de9cd9a | 691 | { |
5e805e44 | 692 | if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0) |
6de9cd9a | 693 | { |
5e805e44 | 694 | edit_modes (opp, u, flags); |
6de9cd9a DN |
695 | return; |
696 | } | |
697 | ||
698 | /* If the file is connected to something else, close it and open a | |
7fcb1804 | 699 | new unit. */ |
6de9cd9a | 700 | |
5e805e44 | 701 | if (!compare_file_filename (u, opp->file, opp->file_len)) |
6de9cd9a | 702 | { |
2ac7316d | 703 | if (sclose (u->s) == -1) |
5e805e44 JJ |
704 | { |
705 | unlock_unit (u); | |
d74b97cc | 706 | generate_error (&opp->common, LIBERROR_OS, |
5e805e44 | 707 | "Error closing file in OPEN statement"); |
6de9cd9a DN |
708 | return; |
709 | } | |
710 | ||
5e805e44 | 711 | u->s = NULL; |
0e05c303 | 712 | |
5e805e44 | 713 | #if !HAVE_UNLINK_OPEN_FILE |
0e05c303 | 714 | if (u->filename && u->flags.status == STATUS_SCRATCH) |
43ff5c7a | 715 | remove (u->filename); |
5e805e44 | 716 | #endif |
9c5f8900 JD |
717 | free (u->filename); |
718 | u->filename = NULL; | |
719 | ||
5e805e44 JJ |
720 | u = new_unit (opp, u, flags); |
721 | if (u != NULL) | |
9c5f8900 | 722 | unlock_unit (u); |
6de9cd9a DN |
723 | return; |
724 | } | |
725 | ||
5e805e44 | 726 | edit_modes (opp, u, flags); |
6de9cd9a DN |
727 | } |
728 | ||
729 | ||
7fcb1804 | 730 | /* Open file. */ |
6de9cd9a | 731 | |
5e805e44 | 732 | extern void st_open (st_parameter_open *opp); |
7d7b8bfe RH |
733 | export_proto(st_open); |
734 | ||
6de9cd9a | 735 | void |
5e805e44 | 736 | st_open (st_parameter_open *opp) |
6de9cd9a DN |
737 | { |
738 | unit_flags flags; | |
909087e0 | 739 | gfc_unit *u = NULL; |
5e805e44 | 740 | GFC_INTEGER_4 cf = opp->common.flags; |
eaa90d25 | 741 | unit_convert conv; |
6de9cd9a | 742 | |
5e805e44 | 743 | library_start (&opp->common); |
6de9cd9a | 744 | |
7fcb1804 | 745 | /* Decode options. */ |
0ef33d44 | 746 | flags.readonly = !(cf & IOPARM_OPEN_HAS_READONLY) ? 0 : opp->readonly; |
6de9cd9a | 747 | |
5e805e44 JJ |
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"); | |
6de9cd9a | 751 | |
5e805e44 JJ |
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"); | |
6de9cd9a | 755 | |
0ef33d44 FR |
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"); | |
759 | ||
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"); | |
763 | ||
5e805e44 JJ |
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"); | |
6de9cd9a | 767 | |
5e805e44 JJ |
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"); | |
6de9cd9a | 771 | |
5e805e44 JJ |
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"); | |
6de9cd9a | 775 | |
10256cbe JD |
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"); | |
779 | ||
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"); | |
783 | ||
931149a6 JD |
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"); | |
787 | ||
10256cbe JD |
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"); | |
791 | ||
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"); | |
795 | ||
5e805e44 JJ |
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"); | |
6de9cd9a | 799 | |
5e805e44 JJ |
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"); | |
6de9cd9a | 803 | |
5e805e44 JJ |
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"); | |
6de9cd9a | 807 | |
eaa90d25 TK |
808 | /* First, we check wether the convert flag has been set via environment |
809 | variable. This overrides the convert tag in the open statement. */ | |
810 | ||
811 | conv = get_unformatted_convert (opp->common.unit); | |
812 | ||
d74b97cc | 813 | if (conv == GFC_CONVERT_NONE) |
181c9f4a | 814 | { |
eaa90d25 TK |
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, | |
818 | convert_opt, | |
819 | "Bad CONVERT parameter in OPEN statement"); | |
820 | else | |
821 | conv = compile_options.convert; | |
181c9f4a | 822 | } |
eaa90d25 | 823 | |
eaa90d25 TK |
824 | switch (conv) |
825 | { | |
d74b97cc FXC |
826 | case GFC_CONVERT_NATIVE: |
827 | case GFC_CONVERT_SWAP: | |
eaa90d25 TK |
828 | break; |
829 | ||
d74b97cc | 830 | case GFC_CONVERT_BIG: |
5675291d | 831 | conv = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP; |
eaa90d25 TK |
832 | break; |
833 | ||
d74b97cc | 834 | case GFC_CONVERT_LITTLE: |
5675291d | 835 | conv = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE; |
eaa90d25 TK |
836 | break; |
837 | ||
838 | default: | |
839 | internal_error (&opp->common, "Illegal value for CONVERT"); | |
840 | break; | |
841 | } | |
842 | ||
843 | flags.convert = conv; | |
181c9f4a | 844 | |
1ef02b9d BD |
845 | if (flags.position != POSITION_UNSPECIFIED |
846 | && flags.access == ACCESS_DIRECT) | |
d74b97cc | 847 | generate_error (&opp->common, LIBERROR_BAD_OPTION, |
6de9cd9a DN |
848 | "Cannot use POSITION with direct access files"); |
849 | ||
0ef33d44 FR |
850 | if (flags.readonly |
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"); | |
854 | ||
1c2e7a3a FXC |
855 | if (flags.access == ACCESS_APPEND) |
856 | { | |
857 | if (flags.position != POSITION_UNSPECIFIED | |
858 | && flags.position != POSITION_APPEND) | |
d74b97cc | 859 | generate_error (&opp->common, LIBERROR_BAD_OPTION, |
5e805e44 JJ |
860 | "Conflicting ACCESS and POSITION flags in" |
861 | " OPEN statement"); | |
862 | ||
2e444427 | 863 | notify_std (&opp->common, GFC_STD_GNU, |
1c2e7a3a FXC |
864 | "Extension: APPEND as a value for ACCESS in OPEN statement"); |
865 | flags.access = ACCESS_SEQUENTIAL; | |
866 | flags.position = POSITION_APPEND; | |
867 | } | |
868 | ||
6de9cd9a DN |
869 | if (flags.position == POSITION_UNSPECIFIED) |
870 | flags.position = POSITION_ASIS; | |
871 | ||
5e805e44 JJ |
872 | if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK) |
873 | { | |
dcfddbd4 | 874 | if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT)) |
c04d4ede | 875 | opp->common.unit = newunit_alloc (); |
09c7dc63 TS |
876 | else if (opp->common.unit < 0) |
877 | { | |
878 | u = find_unit (opp->common.unit); | |
879 | if (u == NULL) /* Negative unit and no NEWUNIT-created unit found. */ | |
1ede59e4 JD |
880 | { |
881 | generate_error (&opp->common, LIBERROR_BAD_OPTION, | |
882 | "Bad unit number in OPEN statement"); | |
883 | library_end (); | |
884 | return; | |
885 | } | |
09c7dc63 | 886 | } |
6de9cd9a | 887 | |
09c7dc63 TS |
888 | if (u == NULL) |
889 | u = find_or_create_unit (opp->common.unit); | |
5e805e44 JJ |
890 | if (u->s == NULL) |
891 | { | |
892 | u = new_unit (opp, u, &flags); | |
893 | if (u != NULL) | |
894 | unlock_unit (u); | |
895 | } | |
896 | else | |
897 | already_open (opp, u, &flags); | |
898 | } | |
4e766b5d JD |
899 | |
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; | |
903 | ||
6de9cd9a DN |
904 | library_end (); |
905 | } |