OSDN Git Service

* runtime/string.c (find_option): Change 3rd argument to
[pf3gnuchains/gcc-fork.git] / libgfortran / io / open.c
1 /* Copyright (C) 2002, 2003, 2004, 2005
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 "config.h"
32 #include <unistd.h>
33 #include <stdio.h>
34 #include <string.h>
35 #include "libgfortran.h"
36 #include "io.h"
37
38
39 static const st_option access_opt[] = {
40   {"sequential", ACCESS_SEQUENTIAL},
41   {"direct", ACCESS_DIRECT},
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
101 /* Given a unit, test to see if the file is positioned at the terminal
102    point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
103    This prevents us from changing the state from AFTER_ENDFILE to
104    AT_ENDFILE.  */
105
106 void
107 test_endfile (gfc_unit * u)
108 {
109   if (u->endfile == NO_ENDFILE && file_length (u->s) == file_position (u->s))
110     u->endfile = AT_ENDFILE;
111 }
112
113
114 /* Change the modes of a file, those that are allowed * to be
115    changed.  */
116
117 static void
118 edit_modes (gfc_unit * u, unit_flags * flags)
119 {
120   /* Complain about attempts to change the unchangeable.  */
121
122   if (flags->status != STATUS_UNSPECIFIED &&
123       u->flags.status != flags->position)
124     generate_error (ERROR_BAD_OPTION,
125                     "Cannot change STATUS parameter in OPEN statement");
126
127   if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access)
128     generate_error (ERROR_BAD_OPTION,
129                     "Cannot change ACCESS parameter in OPEN statement");
130
131   if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form)
132     generate_error (ERROR_BAD_OPTION,
133                     "Cannot change FORM parameter in OPEN statement");
134
135   if (ioparm.recl_in != 0 && ioparm.recl_in != u->recl)
136     generate_error (ERROR_BAD_OPTION,
137                     "Cannot change RECL parameter in OPEN statement");
138
139   if (flags->action != ACTION_UNSPECIFIED && u->flags.access != flags->access)
140     generate_error (ERROR_BAD_OPTION,
141                     "Cannot change ACTION parameter in OPEN statement");
142
143   /* Status must be OLD if present.  */
144
145   if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD)
146     generate_error (ERROR_BAD_OPTION,
147                     "OPEN statement must have a STATUS of OLD");
148
149   if (u->flags.form == FORM_UNFORMATTED)
150     {
151       if (flags->delim != DELIM_UNSPECIFIED)
152         generate_error (ERROR_OPTION_CONFLICT,
153                         "DELIM parameter conflicts with UNFORMATTED form in "
154                         "OPEN statement");
155
156       if (flags->blank != BLANK_UNSPECIFIED)
157         generate_error (ERROR_OPTION_CONFLICT,
158                         "BLANK parameter conflicts with UNFORMATTED form in "
159                         "OPEN statement");
160
161       if (flags->pad != PAD_UNSPECIFIED)
162         generate_error (ERROR_OPTION_CONFLICT,
163                         "PAD paramter conflicts with UNFORMATTED form in "
164                         "OPEN statement");
165     }
166
167   if (ioparm.library_return == LIBRARY_OK)
168     {
169       /* Change the changeable:  */
170       if (flags->blank != BLANK_UNSPECIFIED)
171         u->flags.blank = flags->blank;
172       if (flags->delim != DELIM_UNSPECIFIED)
173         u->flags.delim = flags->delim;
174       if (flags->pad != PAD_UNSPECIFIED)
175         u->flags.pad = flags->pad;
176     }
177
178   /* Reposition the file if necessary.  */
179
180   switch (flags->position)
181     {
182     case POSITION_UNSPECIFIED:
183     case POSITION_ASIS:
184       break;
185
186     case POSITION_REWIND:
187       if (sseek (u->s, 0) == FAILURE)
188         goto seek_error;
189
190       u->current_record = 0;
191       u->last_record = 0;
192
193       test_endfile (u);         /* We might be at the end.  */
194       break;
195
196     case POSITION_APPEND:
197       if (sseek (u->s, file_length (u->s)) == FAILURE)
198         goto seek_error;
199
200       u->current_record = 0;
201       u->endfile = AT_ENDFILE;  /* We are at the end.  */
202       break;
203
204     seek_error:
205       generate_error (ERROR_OS, NULL);
206       break;
207     }
208 }
209
210
211 /* Open an unused unit.  */
212
213 void
214 new_unit (unit_flags * flags)
215 {
216   gfc_unit *u;
217   stream *s;
218   char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
219
220   /* Change unspecifieds to defaults.  Leave (flags->action ==
221      ACTION_UNSPECIFIED) alone so open_external() can set it based on
222      what type of open actually works.  */
223
224   if (flags->access == ACCESS_UNSPECIFIED)
225     flags->access = ACCESS_SEQUENTIAL;
226
227   if (flags->form == FORM_UNSPECIFIED)
228     flags->form = (flags->access == ACCESS_SEQUENTIAL)
229       ? FORM_FORMATTED : FORM_UNFORMATTED;
230
231
232   if (flags->delim == DELIM_UNSPECIFIED)
233     flags->delim = DELIM_NONE;
234   else
235     {
236       if (flags->form == FORM_UNFORMATTED)
237         {
238           generate_error (ERROR_OPTION_CONFLICT,
239                           "DELIM parameter conflicts with UNFORMATTED form in "
240                           "OPEN statement");
241           goto cleanup;
242         }
243     }
244
245   if (flags->blank == BLANK_UNSPECIFIED)
246     flags->blank = BLANK_NULL;
247   else
248     {
249       if (flags->form == FORM_UNFORMATTED)
250         {
251           generate_error (ERROR_OPTION_CONFLICT,
252                           "BLANK parameter conflicts with UNFORMATTED form in "
253                           "OPEN statement");
254           goto cleanup;
255         }
256     }
257
258   if (flags->pad == PAD_UNSPECIFIED)
259     flags->pad = PAD_YES;
260   else
261     {
262       if (flags->form == FORM_UNFORMATTED)
263         {
264           generate_error (ERROR_OPTION_CONFLICT,
265                           "PAD paramter conflicts with UNFORMATTED form in "
266                           "OPEN statement");
267           goto cleanup;
268         }
269     }
270
271   if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT)
272    {
273      generate_error (ERROR_OPTION_CONFLICT,
274                      "ACCESS parameter conflicts with SEQUENTIAL access in "
275                      "OPEN statement");
276      goto cleanup;
277    }
278   else
279    if (flags->position == POSITION_UNSPECIFIED)
280      flags->position = POSITION_ASIS;
281
282
283   if (flags->status == STATUS_UNSPECIFIED)
284     flags->status = STATUS_UNKNOWN;
285
286   /* Checks.  */
287
288   if (flags->access == ACCESS_DIRECT && ioparm.recl_in == 0)
289     {
290       generate_error (ERROR_MISSING_OPTION,
291                       "Missing RECL parameter in OPEN statement");
292       goto cleanup;
293     }
294
295   if (ioparm.recl_in != 0 && ioparm.recl_in <= 0)
296     {
297       generate_error (ERROR_BAD_OPTION,
298                       "RECL parameter is non-positive in OPEN statement");
299       goto cleanup;
300     }
301
302   switch (flags->status)
303     {
304     case STATUS_SCRATCH:
305       if (ioparm.file == NULL)
306         break;
307
308       generate_error (ERROR_BAD_OPTION,
309                       "FILE parameter must not be present in OPEN statement");
310       return;
311
312     case STATUS_OLD:
313     case STATUS_NEW:
314     case STATUS_REPLACE:
315     case STATUS_UNKNOWN:
316       if (ioparm.file != NULL)
317         break;
318
319       ioparm.file = tmpname;
320       ioparm.file_len = sprintf(ioparm.file, "fort.%d", ioparm.unit);
321       break;
322
323     default:
324       internal_error ("new_unit(): Bad status");
325     }
326
327   /* Make sure the file isn't already open someplace else.
328      Do not error if opening file preconnected to stdin, stdout, stderr.  */
329
330   u = find_file ();
331   if (u != NULL
332       && (options.stdin_unit < 0 || u->unit_number != options.stdin_unit)
333       && (options.stdout_unit < 0 || u->unit_number != options.stdout_unit)
334       && (options.stderr_unit < 0 || u->unit_number != options.stderr_unit))
335     {
336       generate_error (ERROR_ALREADY_OPEN, NULL);
337       goto cleanup;
338     }
339
340   /* Open file.  */
341
342   s = open_external (flags);
343   if (s == NULL)
344     {
345       generate_error (ERROR_OS, NULL);
346       goto cleanup;
347     }
348
349   if (flags->status == STATUS_NEW || flags->status == STATUS_REPLACE)
350     flags->status = STATUS_OLD;
351
352   /* Create the unit structure.  */
353
354   u = get_mem (sizeof (gfc_unit) + ioparm.file_len);
355   memset (u, '\0', sizeof (gfc_unit) + ioparm.file_len);
356
357   u->unit_number = ioparm.unit;
358   u->s = s;
359   u->flags = *flags;
360
361   if (flags->position == POSITION_APPEND)
362   {
363     if (sseek (u->s, file_length (u->s)) == FAILURE)
364       generate_error (ERROR_OS, NULL);
365     u->endfile = AT_ENDFILE;
366   }
367
368   /* Unspecified recl ends up with a processor dependent value.  */
369
370   u->recl = (ioparm.recl_in != 0) ? ioparm.recl_in : g.max_offset;
371   u->last_record = 0;
372   u->current_record = 0;
373
374   /* If the file is direct access, calculate the maximum record number
375      via a division now instead of letting the multiplication overflow
376      later.  */
377
378   if (flags->access == ACCESS_DIRECT)
379     u->maxrec = g.max_offset / u->recl;
380
381   memmove (u->file, ioparm.file, ioparm.file_len);
382   u->file_len = ioparm.file_len;
383
384   insert_unit (u);
385
386   /* The file is now connected.  Errors after this point leave the
387      file connected.  Curiously, the standard requires that the
388      position specifier be ignored for new files so a newly connected
389      file starts out that the initial point.  We still need to figure
390      out if the file is at the end or not.  */
391
392   test_endfile (u);
393
394  cleanup:
395
396   /* Free memory associated with a temporary filename.  */
397
398   if (flags->status == STATUS_SCRATCH)
399     free_mem (ioparm.file);
400 }
401
402
403 /* Open a unit which is already open.  This involves changing the
404    modes or closing what is there now and opening the new file.  */
405
406 static void
407 already_open (gfc_unit * u, unit_flags * flags)
408 {
409   if (ioparm.file == NULL)
410     {
411       edit_modes (u, flags);
412       return;
413     }
414
415   /* If the file is connected to something else, close it and open a
416      new unit.  */
417
418   if (!compare_file_filename (u->s, ioparm.file, ioparm.file_len))
419     {
420       if (close_unit (u))
421         {
422           generate_error (ERROR_OS, "Error closing file in OPEN statement");
423           return;
424         }
425
426       new_unit (flags);
427       return;
428     }
429
430   edit_modes (u, flags);
431 }
432
433
434 /* Open file.  */
435
436 extern void st_open (void);
437 export_proto(st_open);
438
439 void
440 st_open (void)
441 {
442   unit_flags flags;
443   gfc_unit *u = NULL;
444  
445   library_start ();
446
447   /* Decode options.  */
448
449   flags.access = (ioparm.access == NULL) ? ACCESS_UNSPECIFIED :
450     find_option (ioparm.access, ioparm.access_len, access_opt,
451                  "Bad ACCESS parameter in OPEN statement");
452
453   flags.action = (ioparm.action == NULL) ? ACTION_UNSPECIFIED :
454     find_option (ioparm.action, ioparm.action_len, action_opt,
455                  "Bad ACTION parameter in OPEN statement");
456
457   flags.blank = (ioparm.blank == NULL) ? BLANK_UNSPECIFIED :
458     find_option (ioparm.blank, ioparm.blank_len, blank_opt,
459                  "Bad BLANK parameter in OPEN statement");
460
461   flags.delim = (ioparm.delim == NULL) ? DELIM_UNSPECIFIED :
462     find_option (ioparm.delim, ioparm.delim_len, delim_opt,
463                  "Bad DELIM parameter in OPEN statement");
464
465   flags.pad = (ioparm.pad == NULL) ? PAD_UNSPECIFIED :
466     find_option (ioparm.pad, ioparm.pad_len, pad_opt,
467                  "Bad PAD parameter in OPEN statement");
468
469   flags.form = (ioparm.form == NULL) ? FORM_UNSPECIFIED :
470     find_option (ioparm.form, ioparm.form_len, form_opt,
471                  "Bad FORM parameter in OPEN statement");
472
473   flags.position = (ioparm.position == NULL) ? POSITION_UNSPECIFIED :
474     find_option (ioparm.position, ioparm.position_len, position_opt,
475                  "Bad POSITION parameter in OPEN statement");
476
477   flags.status = (ioparm.status == NULL) ? STATUS_UNSPECIFIED :
478     find_option (ioparm.status, ioparm.status_len, status_opt,
479                  "Bad STATUS parameter in OPEN statement");
480
481   if (ioparm.unit < 0)
482     generate_error (ERROR_BAD_OPTION, "Bad unit number in OPEN statement");
483
484   if (flags.position != POSITION_UNSPECIFIED
485       && flags.access == ACCESS_DIRECT)
486     generate_error (ERROR_BAD_OPTION,
487                     "Cannot use POSITION with direct access files");
488
489   if (flags.position == POSITION_UNSPECIFIED)
490     flags.position = POSITION_ASIS;
491
492   if (ioparm.library_return != LIBRARY_OK)
493   {
494     library_end ();
495     return;
496   }
497
498   u = find_unit (ioparm.unit);
499
500   if (u == NULL)
501     new_unit (&flags);
502   else
503     already_open (u, &flags);
504
505   library_end ();
506 }