|
145
|
1 /* Copyright (C) 2002-2020 Free Software Foundation, Inc.
|
|
111
|
2 Contributed by Andy Vaught
|
|
|
3
|
|
|
4 This file is part of the GNU Fortran 95 runtime library (libgfortran).
|
|
|
5
|
|
|
6 Libgfortran is free software; you can redistribute it and/or modify
|
|
|
7 it under the terms of the GNU General Public License as published by
|
|
|
8 the Free Software Foundation; either version 3, or (at your option)
|
|
|
9 any later version.
|
|
|
10
|
|
|
11 Libgfortran is distributed in the hope that it will be useful,
|
|
|
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
14 GNU General Public License for more details.
|
|
|
15
|
|
|
16 Under Section 7 of GPL version 3, you are granted additional
|
|
|
17 permissions described in the GCC Runtime Library Exception, version
|
|
|
18 3.1, as published by the Free Software Foundation.
|
|
|
19
|
|
|
20 You should have received a copy of the GNU General Public License and
|
|
|
21 a copy of the GCC Runtime Library Exception along with this program;
|
|
|
22 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
|
|
|
23 <http://www.gnu.org/licenses/>. */
|
|
|
24
|
|
|
25 #include "io.h"
|
|
|
26 #include "unix.h"
|
|
131
|
27 #include "async.h"
|
|
111
|
28 #include <limits.h>
|
|
131
|
29 #if !HAVE_UNLINK_OPEN_FILE
|
|
|
30 #include <string.h>
|
|
|
31 #endif
|
|
111
|
32
|
|
|
33 typedef enum
|
|
|
34 { CLOSE_DELETE, CLOSE_KEEP, CLOSE_UNSPECIFIED }
|
|
|
35 close_status;
|
|
|
36
|
|
|
37 static const st_option status_opt[] = {
|
|
|
38 {"keep", CLOSE_KEEP},
|
|
|
39 {"delete", CLOSE_DELETE},
|
|
|
40 {NULL, 0}
|
|
|
41 };
|
|
|
42
|
|
|
43
|
|
|
44 extern void st_close (st_parameter_close *);
|
|
|
45 export_proto(st_close);
|
|
|
46
|
|
|
47 void
|
|
|
48 st_close (st_parameter_close *clp)
|
|
|
49 {
|
|
|
50 close_status status;
|
|
|
51 gfc_unit *u;
|
|
|
52 #if !HAVE_UNLINK_OPEN_FILE
|
|
|
53 char *path;
|
|
|
54
|
|
|
55 path = NULL;
|
|
|
56 #endif
|
|
|
57
|
|
|
58 library_start (&clp->common);
|
|
|
59
|
|
|
60 status = !(clp->common.flags & IOPARM_CLOSE_HAS_STATUS) ? CLOSE_UNSPECIFIED :
|
|
|
61 find_option (&clp->common, clp->status, clp->status_len,
|
|
|
62 status_opt, "Bad STATUS parameter in CLOSE statement");
|
|
|
63
|
|
131
|
64 u = find_unit (clp->common.unit);
|
|
|
65
|
|
|
66 if (ASYNC_IO && u && u->au)
|
|
|
67 if (async_wait (&(clp->common), u->au))
|
|
|
68 {
|
|
|
69 library_end ();
|
|
|
70 return;
|
|
|
71 }
|
|
|
72
|
|
111
|
73 if ((clp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
|
|
|
74 {
|
|
|
75 library_end ();
|
|
|
76 return;
|
|
|
77 }
|
|
|
78
|
|
|
79 if (u != NULL)
|
|
|
80 {
|
|
|
81 if (close_share (u) < 0)
|
|
|
82 generate_error (&clp->common, LIBERROR_OS, "Problem in CLOSE");
|
|
|
83 if (u->flags.status == STATUS_SCRATCH)
|
|
|
84 {
|
|
|
85 if (status == CLOSE_KEEP)
|
|
|
86 generate_error (&clp->common, LIBERROR_BAD_OPTION,
|
|
|
87 "Can't KEEP a scratch file on CLOSE");
|
|
|
88 #if !HAVE_UNLINK_OPEN_FILE
|
|
|
89 path = strdup (u->filename);
|
|
|
90 #endif
|
|
|
91 }
|
|
|
92 else
|
|
|
93 {
|
|
|
94 if (status == CLOSE_DELETE)
|
|
|
95 {
|
|
|
96 if (u->flags.readonly)
|
|
|
97 generate_warning (&clp->common, "STATUS set to DELETE on CLOSE"
|
|
|
98 " but file protected by READONLY specifier");
|
|
|
99 else
|
|
|
100 {
|
|
|
101 #if HAVE_UNLINK_OPEN_FILE
|
|
145
|
102
|
|
|
103 if (remove (u->filename))
|
|
|
104 generate_error (&clp->common, LIBERROR_OS,
|
|
|
105 "File cannot be deleted");
|
|
111
|
106 #else
|
|
|
107 path = strdup (u->filename);
|
|
|
108 #endif
|
|
|
109 }
|
|
|
110 }
|
|
|
111 }
|
|
|
112
|
|
|
113 close_unit (u);
|
|
|
114
|
|
|
115 #if !HAVE_UNLINK_OPEN_FILE
|
|
|
116 if (path != NULL)
|
|
|
117 {
|
|
145
|
118 if (remove (path))
|
|
|
119 generate_error (&clp->common, LIBERROR_OS,
|
|
|
120 "File cannot be deleted");
|
|
111
|
121 free (path);
|
|
|
122 }
|
|
|
123 #endif
|
|
|
124 }
|
|
|
125
|
|
|
126 /* CLOSE on unconnected unit is legal and a no-op: F95 std., 9.3.5. */
|
|
|
127 library_end ();
|
|
|
128 }
|
