1 /* Implementation of the EXECUTE_COMMAND_LINE intrinsic.
2 Copyright (C) 2009 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"
36 #ifdef HAVE_SYS_WAIT_H
41 enum { EXEC_NOERROR
= 0, EXEC_SYSTEMFAILED
};
42 static const char *cmdmsg_values
[] =
43 { "", "Execution of child process impossible" };
48 set_cmdstat (int *cmdstat
, int value
)
53 runtime_error ("Could not execute command line");
58 execute_command_line (const char *command
, bool wait
, int *exitstat
,
59 int *cmdstat
, char *cmdmsg
,
60 gfc_charlen_type command_len
,
61 gfc_charlen_type cmdmsg_len
)
63 /* Transform the Fortran string to a C string. */
64 char cmd
[command_len
+ 1];
65 memcpy (cmd
, command
, command_len
);
66 cmd
[command_len
] = '\0';
68 /* Flush all I/O units before executing the command. */
71 #if defined(HAVE_FORK)
74 /* Asynchronous execution. */
77 set_cmdstat (cmdstat
, 0);
79 if ((pid
= fork()) < 0)
80 set_cmdstat (cmdstat
, EXEC_SYSTEMFAILED
);
84 int res
= system (cmd
);
85 _exit (WIFEXITED(res
) ? WEXITSTATUS(res
) : res
);
91 /* Synchronous execution. */
92 int res
= system (cmd
);
95 set_cmdstat (cmdstat
, -2);
97 set_cmdstat (cmdstat
, EXEC_SYSTEMFAILED
);
100 set_cmdstat (cmdstat
, 0);
101 #if defined(WEXITSTATUS) && defined(WIFEXITED)
102 *exitstat
= WIFEXITED(res
) ? WEXITSTATUS(res
) : res
;
109 /* Now copy back to the Fortran string if needed. */
110 if (cmdstat
&& *cmdstat
> 0)
113 fstrcpy (cmdmsg
, cmdmsg_len
, cmdmsg_values
[*cmdstat
],
114 strlen (cmdmsg_values
[*cmdstat
]));
116 runtime_error ("Failure in EXECUTE_COMMAND_LINE: %s",
117 cmdmsg_values
[*cmdstat
]);
123 execute_command_line_i4 (const char *command
, GFC_LOGICAL_4
*wait
,
124 GFC_INTEGER_4
*exitstat
, GFC_INTEGER_4
*cmdstat
,
125 char *cmdmsg
, gfc_charlen_type command_len
,
126 gfc_charlen_type cmdmsg_len
);
127 export_proto(execute_command_line_i4
);
130 execute_command_line_i4 (const char *command
, GFC_LOGICAL_4
*wait
,
131 GFC_INTEGER_4
*exitstat
, GFC_INTEGER_4
*cmdstat
,
132 char *cmdmsg
, gfc_charlen_type command_len
,
133 gfc_charlen_type cmdmsg_len
)
135 bool w
= wait
? *wait
: true;
136 int estat
, estat_initial
, cstat
;
139 estat_initial
= estat
= *exitstat
;
141 execute_command_line (command
, w
, &estat
, cmdstat
? &cstat
: NULL
,
142 cmdmsg
, command_len
, cmdmsg_len
);
144 if (exitstat
&& estat
!= estat_initial
)
152 execute_command_line_i8 (const char *command
, GFC_LOGICAL_8
*wait
,
153 GFC_INTEGER_8
*exitstat
, GFC_INTEGER_8
*cmdstat
,
154 char *cmdmsg
, gfc_charlen_type command_len
,
155 gfc_charlen_type cmdmsg_len
);
156 export_proto(execute_command_line_i8
);
159 execute_command_line_i8 (const char *command
, GFC_LOGICAL_8
*wait
,
160 GFC_INTEGER_8
*exitstat
, GFC_INTEGER_8
*cmdstat
,
161 char *cmdmsg
, gfc_charlen_type command_len
,
162 gfc_charlen_type cmdmsg_len
)
164 bool w
= wait
? *wait
: true;
165 int estat
, estat_initial
, cstat
;
168 estat_initial
= estat
= *exitstat
;
170 execute_command_line (command
, w
, &estat
, cmdstat
? &cstat
: NULL
,
171 cmdmsg
, command_len
, cmdmsg_len
);
173 if (exitstat
&& estat
!= estat_initial
)