1 /* Implementation of the EXECUTE_COMMAND_LINE intrinsic.
2 Copyright (C) 2009-2013 Free Software Foundation, Inc.
3 Contributed by François-Xavier Coudert.
4
5 This file is part of the GNU Fortran runtime library (libgfortran).
6
7 Libgfortran is free software; you can redistribute it and/or modify it under
8 the terms of the GNU General Public License as published by the Free
9 Software Foundation; either version 3, or (at your option) any later
10 version.
11
12 Libgfortran is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16
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/>. */
25
26 #include "libgfortran.h"
27 #include <string.h>
28 #include <stdbool.h>
29 #include <stdlib.h>
30
31 #ifdef HAVE_UNISTD_H
32 #include <unistd.h>
33 #endif
34 #ifdef HAVE_SYS_WAIT_H
35 #include <sys/wait.h>
36 #endif
37
38
39 enum { EXEC_SYNCHRONOUS = -2, EXEC_NOERROR = 0, EXEC_SYSTEMFAILED,
40 EXEC_CHILDFAILED };
41 static const char *cmdmsg_values[] =
42 { "",
43 "Termination status of the command-language interpreter cannot be obtained",
44 "Execution of child process impossible" };
45
46
47
48 static void
set_cmdstat(int * cmdstat,int value)49 set_cmdstat (int *cmdstat, int value)
50 {
51 if (cmdstat)
52 *cmdstat = value;
53 else if (value > EXEC_NOERROR)
54 runtime_error ("Could not execute command line");
55 }
56
57
58 static void
execute_command_line(const char * command,bool wait,int * exitstat,int * cmdstat,char * cmdmsg,gfc_charlen_type command_len,gfc_charlen_type cmdmsg_len)59 execute_command_line (const char *command, bool wait, int *exitstat,
60 int *cmdstat, char *cmdmsg,
61 gfc_charlen_type command_len,
62 gfc_charlen_type cmdmsg_len)
63 {
64 /* Transform the Fortran string to a C string. */
65 char cmd[command_len + 1];
66 memcpy (cmd, command, command_len);
67 cmd[command_len] = '\0';
68
69 /* Flush all I/O units before executing the command. */
70 flush_all_units();
71
72 #if defined(HAVE_FORK)
73 if (!wait)
74 {
75 /* Asynchronous execution. */
76 pid_t pid;
77
78 set_cmdstat (cmdstat, EXEC_NOERROR);
79
80 if ((pid = fork()) < 0)
81 set_cmdstat (cmdstat, EXEC_CHILDFAILED);
82 else if (pid == 0)
83 {
84 /* Child process. */
85 int res = system (cmd);
86 _exit (WIFEXITED(res) ? WEXITSTATUS(res) : res);
87 }
88 }
89 else
90 #endif
91 {
92 /* Synchronous execution. */
93 int res = system (cmd);
94
95 if (res == -1)
96 set_cmdstat (cmdstat, EXEC_SYSTEMFAILED);
97 #ifndef HAVE_FORK
98 else if (!wait)
99 set_cmdstat (cmdstat, EXEC_SYNCHRONOUS);
100 #endif
101 else
102 set_cmdstat (cmdstat, EXEC_NOERROR);
103
104 if (res != -1)
105 {
106 #if defined(WEXITSTATUS) && defined(WIFEXITED)
107 *exitstat = WIFEXITED(res) ? WEXITSTATUS(res) : res;
108 #else
109 *exitstat = res;
110 #endif
111 }
112 }
113
114 /* Now copy back to the Fortran string if needed. */
115 if (cmdstat && *cmdstat > EXEC_NOERROR)
116 {
117 if (cmdmsg)
118 fstrcpy (cmdmsg, cmdmsg_len, cmdmsg_values[*cmdstat],
119 strlen (cmdmsg_values[*cmdstat]));
120 else
121 runtime_error ("Failure in EXECUTE_COMMAND_LINE: %s",
122 cmdmsg_values[*cmdstat]);
123 }
124 }
125
126
127 extern void
128 execute_command_line_i4 (const char *command, GFC_LOGICAL_4 *wait,
129 GFC_INTEGER_4 *exitstat, GFC_INTEGER_4 *cmdstat,
130 char *cmdmsg, gfc_charlen_type command_len,
131 gfc_charlen_type cmdmsg_len);
132 export_proto(execute_command_line_i4);
133
134 void
execute_command_line_i4(const char * command,GFC_LOGICAL_4 * wait,GFC_INTEGER_4 * exitstat,GFC_INTEGER_4 * cmdstat,char * cmdmsg,gfc_charlen_type command_len,gfc_charlen_type cmdmsg_len)135 execute_command_line_i4 (const char *command, GFC_LOGICAL_4 *wait,
136 GFC_INTEGER_4 *exitstat, GFC_INTEGER_4 *cmdstat,
137 char *cmdmsg, gfc_charlen_type command_len,
138 gfc_charlen_type cmdmsg_len)
139 {
140 bool w = wait ? *wait : true;
141 int estat, estat_initial, cstat;
142
143 if (exitstat)
144 estat_initial = estat = *exitstat;
145
146 execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL,
147 cmdmsg, command_len, cmdmsg_len);
148
149 if (exitstat && estat != estat_initial)
150 *exitstat = estat;
151 if (cmdstat)
152 *cmdstat = cstat;
153 }
154
155
156 extern void
157 execute_command_line_i8 (const char *command, GFC_LOGICAL_8 *wait,
158 GFC_INTEGER_8 *exitstat, GFC_INTEGER_8 *cmdstat,
159 char *cmdmsg, gfc_charlen_type command_len,
160 gfc_charlen_type cmdmsg_len);
161 export_proto(execute_command_line_i8);
162
163 void
execute_command_line_i8(const char * command,GFC_LOGICAL_8 * wait,GFC_INTEGER_8 * exitstat,GFC_INTEGER_8 * cmdstat,char * cmdmsg,gfc_charlen_type command_len,gfc_charlen_type cmdmsg_len)164 execute_command_line_i8 (const char *command, GFC_LOGICAL_8 *wait,
165 GFC_INTEGER_8 *exitstat, GFC_INTEGER_8 *cmdstat,
166 char *cmdmsg, gfc_charlen_type command_len,
167 gfc_charlen_type cmdmsg_len)
168 {
169 bool w = wait ? *wait : true;
170 int estat, estat_initial, cstat;
171
172 if (exitstat)
173 estat_initial = estat = *exitstat;
174
175 execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL,
176 cmdmsg, command_len, cmdmsg_len);
177
178 if (exitstat && estat != estat_initial)
179 *exitstat = estat;
180 if (cmdstat)
181 *cmdstat = cstat;
182 }
183