1 /* Implementation of the EXECUTE_COMMAND_LINE intrinsic.
2 Copyright (C) 2009-2013 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"
34 #ifdef HAVE_SYS_WAIT_H
39 enum { EXEC_SYNCHRONOUS
= -2, EXEC_NOERROR
= 0, EXEC_SYSTEMFAILED
,
41 static const char *cmdmsg_values
[] =
43 "Termination status of the command-language interpreter cannot be obtained",
44 "Execution of child process impossible" };
49 set_cmdstat (int *cmdstat
, int value
)
53 else if (value
> EXEC_NOERROR
)
54 runtime_error ("Could not execute command line");
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
)
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';
69 /* Flush all I/O units before executing the command. */
72 #if defined(HAVE_FORK)
75 /* Asynchronous execution. */
78 set_cmdstat (cmdstat
, EXEC_NOERROR
);
80 if ((pid
= fork()) < 0)
81 set_cmdstat (cmdstat
, EXEC_CHILDFAILED
);
85 int res
= system (cmd
);
86 _exit (WIFEXITED(res
) ? WEXITSTATUS(res
) : res
);
92 /* Synchronous execution. */
93 int res
= system (cmd
);
96 set_cmdstat (cmdstat
, EXEC_SYSTEMFAILED
);
99 set_cmdstat (cmdstat
, EXEC_SYNCHRONOUS
);
102 set_cmdstat (cmdstat
, EXEC_NOERROR
);
106 #if defined(WEXITSTATUS) && defined(WIFEXITED)
107 *exitstat
= WIFEXITED(res
) ? WEXITSTATUS(res
) : res
;
114 /* Now copy back to the Fortran string if needed. */
115 if (cmdstat
&& *cmdstat
> EXEC_NOERROR
)
118 fstrcpy (cmdmsg
, cmdmsg_len
, cmdmsg_values
[*cmdstat
],
119 strlen (cmdmsg_values
[*cmdstat
]));
121 runtime_error ("Failure in EXECUTE_COMMAND_LINE: %s",
122 cmdmsg_values
[*cmdstat
]);
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
);
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
)
140 bool w
= wait
? *wait
: true;
141 int estat
, estat_initial
, cstat
;
144 estat_initial
= estat
= *exitstat
;
146 execute_command_line (command
, w
, &estat
, cmdstat
? &cstat
: NULL
,
147 cmdmsg
, command_len
, cmdmsg_len
);
149 if (exitstat
&& estat
!= estat_initial
)
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
);
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
)
169 bool w
= wait
? *wait
: true;
170 int estat
, estat_initial
, cstat
;
173 estat_initial
= estat
= *exitstat
;
175 execute_command_line (command
, w
, &estat
, cmdstat
? &cstat
: NULL
,
176 cmdmsg
, command_len
, cmdmsg_len
);
178 if (exitstat
&& estat
!= estat_initial
)