2010-09-01 10:33:11 +02:00
|
|
|
/* Implementation of the EXECUTE_COMMAND_LINE intrinsic.
|
|
|
|
Copyright (C) 2009 Free Software Foundation, Inc.
|
|
|
|
Contributed by François-Xavier Coudert.
|
|
|
|
|
|
|
|
This file is part of the GNU Fortran runtime library (libgfortran).
|
|
|
|
|
|
|
|
Libgfortran is free software; you can redistribute it and/or modify it under
|
|
|
|
the terms of the GNU General Public License as published by the Free
|
|
|
|
Software Foundation; either version 3, or (at your option) any later
|
|
|
|
version.
|
|
|
|
|
|
|
|
Libgfortran is distributed in the hope that it will be useful, but WITHOUT
|
|
|
|
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
|
for more details.
|
|
|
|
|
|
|
|
Under Section 7 of GPL version 3, you are granted additional
|
|
|
|
permissions described in the GCC Runtime Library Exception, version
|
|
|
|
3.1, as published by the Free Software Foundation.
|
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License and
|
|
|
|
a copy of the GCC Runtime Library Exception along with this program;
|
|
|
|
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
|
|
|
|
<http://www.gnu.org/licenses/>. */
|
|
|
|
|
|
|
|
#include "libgfortran.h"
|
|
|
|
#include <string.h>
|
|
|
|
#include <stdbool.h>
|
|
|
|
|
|
|
|
#ifdef HAVE_STDLIB_H
|
|
|
|
#include <stdlib.h>
|
|
|
|
#endif
|
|
|
|
#ifdef HAVE_UNISTD_H
|
|
|
|
#include <unistd.h>
|
|
|
|
#endif
|
|
|
|
#ifdef HAVE_SYS_WAIT_H
|
|
|
|
#include <sys/wait.h>
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
2011-05-14 08:35:18 +02:00
|
|
|
enum { EXEC_SYNCHRONOUS = -2, EXEC_NOERROR = 0, EXEC_SYSTEMFAILED,
|
|
|
|
EXEC_CHILDFAILED };
|
2010-09-01 10:33:11 +02:00
|
|
|
static const char *cmdmsg_values[] =
|
2011-05-14 08:35:18 +02:00
|
|
|
{ "",
|
|
|
|
"Termination status of the command-language interpreter cannot be obtained",
|
|
|
|
"Execution of child process impossible" };
|
2010-09-01 10:33:11 +02:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
static void
|
|
|
|
set_cmdstat (int *cmdstat, int value)
|
|
|
|
{
|
|
|
|
if (cmdstat)
|
|
|
|
*cmdstat = value;
|
2011-05-14 08:35:18 +02:00
|
|
|
else if (value > EXEC_NOERROR)
|
2010-09-01 10:33:11 +02:00
|
|
|
runtime_error ("Could not execute command line");
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
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)
|
|
|
|
{
|
|
|
|
/* Transform the Fortran string to a C string. */
|
|
|
|
char cmd[command_len + 1];
|
|
|
|
memcpy (cmd, command, command_len);
|
|
|
|
cmd[command_len] = '\0';
|
|
|
|
|
|
|
|
/* Flush all I/O units before executing the command. */
|
|
|
|
flush_all_units();
|
|
|
|
|
|
|
|
#if defined(HAVE_FORK)
|
|
|
|
if (!wait)
|
|
|
|
{
|
|
|
|
/* Asynchronous execution. */
|
|
|
|
pid_t pid;
|
|
|
|
|
2011-05-14 08:35:18 +02:00
|
|
|
set_cmdstat (cmdstat, EXEC_NOERROR);
|
2010-09-01 10:33:11 +02:00
|
|
|
|
|
|
|
if ((pid = fork()) < 0)
|
2011-05-14 08:35:18 +02:00
|
|
|
set_cmdstat (cmdstat, EXEC_CHILDFAILED);
|
2010-09-01 10:33:11 +02:00
|
|
|
else if (pid == 0)
|
|
|
|
{
|
|
|
|
/* Child process. */
|
|
|
|
int res = system (cmd);
|
|
|
|
_exit (WIFEXITED(res) ? WEXITSTATUS(res) : res);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
else
|
|
|
|
#endif
|
|
|
|
{
|
|
|
|
/* Synchronous execution. */
|
|
|
|
int res = system (cmd);
|
|
|
|
|
2011-05-14 08:35:18 +02:00
|
|
|
if (res == -1)
|
2010-09-01 10:33:11 +02:00
|
|
|
set_cmdstat (cmdstat, EXEC_SYSTEMFAILED);
|
2011-05-14 08:35:18 +02:00
|
|
|
else if (!wait)
|
|
|
|
set_cmdstat (cmdstat, EXEC_SYNCHRONOUS);
|
2010-09-01 10:33:11 +02:00
|
|
|
else
|
2011-05-14 08:35:18 +02:00
|
|
|
set_cmdstat (cmdstat, EXEC_NOERROR);
|
|
|
|
|
|
|
|
if (res != -1)
|
2010-09-01 10:33:11 +02:00
|
|
|
{
|
|
|
|
#if defined(WEXITSTATUS) && defined(WIFEXITED)
|
|
|
|
*exitstat = WIFEXITED(res) ? WEXITSTATUS(res) : res;
|
|
|
|
#else
|
|
|
|
*exitstat = res;
|
|
|
|
#endif
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
/* Now copy back to the Fortran string if needed. */
|
2011-05-14 08:35:18 +02:00
|
|
|
if (cmdstat && *cmdstat > EXEC_NOERROR)
|
2010-09-01 10:33:11 +02:00
|
|
|
{
|
|
|
|
if (cmdmsg)
|
|
|
|
fstrcpy (cmdmsg, cmdmsg_len, cmdmsg_values[*cmdstat],
|
|
|
|
strlen (cmdmsg_values[*cmdstat]));
|
|
|
|
else
|
|
|
|
runtime_error ("Failure in EXECUTE_COMMAND_LINE: %s",
|
|
|
|
cmdmsg_values[*cmdstat]);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
extern 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);
|
|
|
|
export_proto(execute_command_line_i4);
|
|
|
|
|
|
|
|
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)
|
|
|
|
{
|
|
|
|
bool w = wait ? *wait : true;
|
|
|
|
int estat, estat_initial, cstat;
|
|
|
|
|
|
|
|
if (exitstat)
|
|
|
|
estat_initial = estat = *exitstat;
|
|
|
|
|
|
|
|
execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL,
|
|
|
|
cmdmsg, command_len, cmdmsg_len);
|
|
|
|
|
|
|
|
if (exitstat && estat != estat_initial)
|
|
|
|
*exitstat = estat;
|
|
|
|
if (cmdstat)
|
|
|
|
*cmdstat = cstat;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
extern 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);
|
|
|
|
export_proto(execute_command_line_i8);
|
|
|
|
|
|
|
|
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)
|
|
|
|
{
|
|
|
|
bool w = wait ? *wait : true;
|
|
|
|
int estat, estat_initial, cstat;
|
|
|
|
|
|
|
|
if (exitstat)
|
|
|
|
estat_initial = estat = *exitstat;
|
|
|
|
|
|
|
|
execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL,
|
|
|
|
cmdmsg, command_len, cmdmsg_len);
|
|
|
|
|
|
|
|
if (exitstat && estat != estat_initial)
|
|
|
|
*exitstat = estat;
|
|
|
|
if (cmdstat)
|
|
|
|
*cmdstat = cstat;
|
|
|
|
}
|