1 /* Implementation of the EXECUTE_COMMAND_LINE intrinsic.
2 Copyright (C) 2009-2023 Free Software Foundation, Inc.
3 Contributed by François-Xavier Coudert.
5 This file is part of the GNU Fortran runtime library (libgfortran).
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
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
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/>. */
26 #include "libgfortran.h"
32 #ifdef HAVE_SYS_WAIT_H
35 #ifdef HAVE_POSIX_SPAWN
38 # include <crt_externs.h>
39 # define environ (*_NSGetEnviron ())
41 extern char **environ
;
44 #if defined(HAVE_POSIX_SPAWN) || defined(HAVE_FORK)
48 enum { EXEC_SYNCHRONOUS
= -2, EXEC_NOERROR
= 0, EXEC_SYSTEMFAILED
,
49 EXEC_CHILDFAILED
, EXEC_INVALIDCOMMAND
};
50 static const char *cmdmsg_values
[] =
52 "Termination status of the command-language interpreter cannot be obtained",
53 "Execution of child process impossible",
54 "Invalid command line" };
59 set_cmdstat (int *cmdstat
, int value
)
63 else if (value
> EXEC_NOERROR
)
66 char msg
[MSGLEN
] = "EXECUTE_COMMAND_LINE: ";
67 strncat (msg
, cmdmsg_values
[value
], MSGLEN
- strlen(msg
) - 1);
68 runtime_error ("%s", msg
);
73 #if defined(HAVE_WAITPID) && defined(HAVE_SIGACTION)
75 sigchld_handler (int signum
__attribute__((unused
)))
77 while (waitpid ((pid_t
)(-1), NULL
, WNOHANG
) > 0) {}
82 execute_command_line (const char *command
, bool wait
, int *exitstat
,
83 int *cmdstat
, char *cmdmsg
,
84 gfc_charlen_type command_len
,
85 gfc_charlen_type cmdmsg_len
)
87 /* Transform the Fortran string to a C string. */
88 char *cmd
= fc_strdup (command
, command_len
);
90 /* Flush all I/O units before executing the command. */
93 #if defined(HAVE_POSIX_SPAWN) || defined(HAVE_FORK)
96 /* Asynchronous execution. */
99 set_cmdstat (cmdstat
, EXEC_NOERROR
);
101 #if defined(HAVE_SIGACTION) && defined(HAVE_WAITPID)
102 static bool sig_init_saved
;
103 bool sig_init
= __atomic_load_n (&sig_init_saved
, __ATOMIC_RELAXED
);
107 sa
.sa_handler
= &sigchld_handler
;
108 sigemptyset(&sa
.sa_mask
);
109 sa
.sa_flags
= SA_RESTART
| SA_NOCLDSTOP
;
110 sigaction(SIGCHLD
, &sa
, 0);
111 __atomic_store_n (&sig_init_saved
, true, __ATOMIC_RELAXED
);
115 #ifdef HAVE_POSIX_SPAWN
116 const char * const argv
[] = {"sh", "-c", cmd
, NULL
};
117 if (posix_spawn (&pid
, "/bin/sh", NULL
, NULL
,
118 (char * const* restrict
) argv
, environ
))
119 set_cmdstat (cmdstat
, EXEC_CHILDFAILED
);
120 #elif defined(HAVE_FORK)
121 if ((pid
= fork()) < 0)
122 set_cmdstat (cmdstat
, EXEC_CHILDFAILED
);
126 int res
= system (cmd
);
127 _exit (WIFEXITED(res
) ? WEXITSTATUS(res
) : res
);
134 /* Synchronous execution. */
135 int res
= system (cmd
);
138 set_cmdstat (cmdstat
, EXEC_SYSTEMFAILED
);
139 #if !defined(HAVE_POSIX_SPAWN) && !defined(HAVE_FORK)
141 set_cmdstat (cmdstat
, EXEC_SYNCHRONOUS
);
143 else if (res
== 127 || res
== 126
144 #if defined(WEXITSTATUS) && defined(WIFEXITED)
145 || (WIFEXITED(res
) && WEXITSTATUS(res
) == 127)
146 || (WIFEXITED(res
) && WEXITSTATUS(res
) == 126)
149 /* Shell return codes 126 and 127 mean that the command line could
150 not be executed for various reasons. */
151 set_cmdstat (cmdstat
, EXEC_INVALIDCOMMAND
);
153 set_cmdstat (cmdstat
, EXEC_NOERROR
);
157 #if defined(WEXITSTATUS) && defined(WIFEXITED)
158 *exitstat
= WIFEXITED(res
) ? WEXITSTATUS(res
) : res
;
167 /* Now copy back to the Fortran string if needed. */
168 if (cmdstat
&& *cmdstat
> EXEC_NOERROR
&& cmdmsg
)
169 fstrcpy (cmdmsg
, cmdmsg_len
, cmdmsg_values
[*cmdstat
],
170 strlen (cmdmsg_values
[*cmdstat
]));
175 execute_command_line_i4 (const char *command
, GFC_LOGICAL_4
*wait
,
176 GFC_INTEGER_4
*exitstat
, GFC_INTEGER_4
*cmdstat
,
177 char *cmdmsg
, gfc_charlen_type command_len
,
178 gfc_charlen_type cmdmsg_len
);
179 export_proto(execute_command_line_i4
);
182 execute_command_line_i4 (const char *command
, GFC_LOGICAL_4
*wait
,
183 GFC_INTEGER_4
*exitstat
, GFC_INTEGER_4
*cmdstat
,
184 char *cmdmsg
, gfc_charlen_type command_len
,
185 gfc_charlen_type cmdmsg_len
)
187 bool w
= wait
? *wait
: true;
188 int estat
, estat_initial
, cstat
;
191 estat_initial
= estat
= *exitstat
;
193 execute_command_line (command
, w
, &estat
, cmdstat
? &cstat
: NULL
,
194 cmdmsg
, command_len
, cmdmsg_len
);
196 if (exitstat
&& estat
!= estat_initial
)
204 execute_command_line_i8 (const char *command
, GFC_LOGICAL_8
*wait
,
205 GFC_INTEGER_8
*exitstat
, GFC_INTEGER_8
*cmdstat
,
206 char *cmdmsg
, gfc_charlen_type command_len
,
207 gfc_charlen_type cmdmsg_len
);
208 export_proto(execute_command_line_i8
);
211 execute_command_line_i8 (const char *command
, GFC_LOGICAL_8
*wait
,
212 GFC_INTEGER_8
*exitstat
, GFC_INTEGER_8
*cmdstat
,
213 char *cmdmsg
, gfc_charlen_type command_len
,
214 gfc_charlen_type cmdmsg_len
)
216 bool w
= wait
? *wait
: true;
217 int estat
, estat_initial
, cstat
;
220 estat_initial
= estat
= *exitstat
;
222 execute_command_line (command
, w
, &estat
, cmdstat
? &cstat
: NULL
,
223 cmdmsg
, command_len
, cmdmsg_len
);
225 if (exitstat
&& estat
!= estat_initial
)