From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- libgfortran/intrinsics/execute_command_line.c | 177 ++++++++++++++++++++++++++ 1 file changed, 177 insertions(+) create mode 100644 libgfortran/intrinsics/execute_command_line.c (limited to 'libgfortran/intrinsics/execute_command_line.c') diff --git a/libgfortran/intrinsics/execute_command_line.c b/libgfortran/intrinsics/execute_command_line.c new file mode 100644 index 000000000..4e3c4451d --- /dev/null +++ b/libgfortran/intrinsics/execute_command_line.c @@ -0,0 +1,177 @@ +/* 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 +. */ + +#include "libgfortran.h" +#include +#include + +#ifdef HAVE_STDLIB_H +#include +#endif +#ifdef HAVE_UNISTD_H +#include +#endif +#ifdef HAVE_SYS_WAIT_H +#include +#endif + + +enum { EXEC_NOERROR = 0, EXEC_SYSTEMFAILED }; +static const char *cmdmsg_values[] = + { "", "Execution of child process impossible" }; + + + +static void +set_cmdstat (int *cmdstat, int value) +{ + if (cmdstat) + *cmdstat = value; + else if (value != 0) + 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; + + set_cmdstat (cmdstat, 0); + + if ((pid = fork()) < 0) + set_cmdstat (cmdstat, EXEC_SYSTEMFAILED); + else if (pid == 0) + { + /* Child process. */ + int res = system (cmd); + _exit (WIFEXITED(res) ? WEXITSTATUS(res) : res); + } + } + else +#endif + { + /* Synchronous execution. */ + int res = system (cmd); + + if (!wait) + set_cmdstat (cmdstat, -2); + else if (res == -1) + set_cmdstat (cmdstat, EXEC_SYSTEMFAILED); + else + { + set_cmdstat (cmdstat, 0); +#if defined(WEXITSTATUS) && defined(WIFEXITED) + *exitstat = WIFEXITED(res) ? WEXITSTATUS(res) : res; +#else + *exitstat = res; +#endif + } + } + + /* Now copy back to the Fortran string if needed. */ + if (cmdstat && *cmdstat > 0) + { + 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; +} -- cgit v1.2.3