libgfortran/intrinsics/execute_command_line.c

   1 /* Implementation of the EXECUTE_COMMAND_LINE intrinsic.
   2    Copyright (C) 2009-2013 Free Software Foundation, Inc.
   3    Contributed by FranÃ§ois-Xavier Coudert.
   4
   5 This file is part of the GNU Fortran runtime library (libgfortran).
   6
   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
  10 version.
  11
  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
  15 for more details.
  16
  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.
  20
  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/>.  */
  25
  26 #include "libgfortran.h"
  27 #include <string.h>
  28 #include <stdlib.h>
  29
  30 #ifdef HAVE_UNISTD_H
  31 #include <unistd.h>
  32 #endif
  33 #ifdef  HAVE_SYS_WAIT_H
  34 #include <sys/wait.h>
  35 #endif
  36
  37
  38 enum { EXEC_SYNCHRONOUS = -2, EXEC_NOERROR = 0, EXEC_SYSTEMFAILED,
  39        EXEC_CHILDFAILED };
  40 static const char *cmdmsg_values[] =
  41   { "",
  42     "Termination status of the command-language interpreter cannot be obtained",
  43     "Execution of child process impossible" };
  44
  45
  46
  47 static void
  48 set_cmdstat (int *cmdstat, int value)
  49 {
  50   if (cmdstat)
  51     *cmdstat = value;
  52   else if (value > EXEC_NOERROR)
  53     runtime_error ("Could not execute command line");
  54 }
  55
  56
  57 static void
  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)
  62 {
  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';
  67
  68   /* Flush all I/O units before executing the command.  */
  69   flush_all_units();
  70
  71 #if defined(HAVE_FORK)
  72   if (!wait)
  73     {
  74       /* Asynchronous execution.  */
  75       pid_t pid;
  76
  77       set_cmdstat (cmdstat, EXEC_NOERROR);
  78
  79       if ((pid = fork()) < 0)
  80         set_cmdstat (cmdstat, EXEC_CHILDFAILED);
  81       else if (pid == 0)
  82         {
  83           /* Child process.  */
  84           int res = system (cmd);
  85           _exit (WIFEXITED(res) ? WEXITSTATUS(res) : res);
  86         }
  87     }
  88   else
  89 #endif
  90     {
  91       /* Synchronous execution.  */
  92       int res = system (cmd);
  93
  94       if (res == -1)
  95         set_cmdstat (cmdstat, EXEC_SYSTEMFAILED);
  96 #ifndef HAVE_FORK
  97       else if (!wait)
  98         set_cmdstat (cmdstat, EXEC_SYNCHRONOUS);
  99 #endif
 100       else
 101         set_cmdstat (cmdstat, EXEC_NOERROR);
 102
 103       if (res != -1)
 104         {
 105 #if defined(WEXITSTATUS) && defined(WIFEXITED)
 106           *exitstat = WIFEXITED(res) ? WEXITSTATUS(res) : res;
 107 #else
 108           *exitstat = res;
 109 #endif
 110         }
 111     }
 112
 113   /* Now copy back to the Fortran string if needed.  */
 114   if (cmdstat && *cmdstat > EXEC_NOERROR)
 115     {
 116       if (cmdmsg)
 117         fstrcpy (cmdmsg, cmdmsg_len, cmdmsg_values[*cmdstat],
 118                 strlen (cmdmsg_values[*cmdstat]));
 119       else
 120         runtime_error ("Failure in EXECUTE_COMMAND_LINE: %s",
 121                        cmdmsg_values[*cmdstat]);
 122     }
 123 }
 124
 125
 126 extern void
 127 execute_command_line_i4 (const char *command, GFC_LOGICAL_4 *wait,
 128                          GFC_INTEGER_4 *exitstat, GFC_INTEGER_4 *cmdstat,
 129                          char *cmdmsg, gfc_charlen_type command_len,
 130                          gfc_charlen_type cmdmsg_len);
 131 export_proto(execute_command_line_i4);
 132
 133 void
 134 execute_command_line_i4 (const char *command, GFC_LOGICAL_4 *wait,
 135                          GFC_INTEGER_4 *exitstat, GFC_INTEGER_4 *cmdstat,
 136                          char *cmdmsg, gfc_charlen_type command_len,
 137                          gfc_charlen_type cmdmsg_len)
 138 {
 139   bool w = wait ? *wait : true;
 140   int estat, estat_initial, cstat;
 141
 142   if (exitstat)
 143     estat_initial = estat = *exitstat;
 144
 145   execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL,
 146                         cmdmsg, command_len, cmdmsg_len);
 147
 148   if (exitstat && estat != estat_initial)
 149     *exitstat = estat;
 150   if (cmdstat)
 151     *cmdstat = cstat;
 152 }
 153
 154
 155 extern void
 156 execute_command_line_i8 (const char *command, GFC_LOGICAL_8 *wait,
 157                          GFC_INTEGER_8 *exitstat, GFC_INTEGER_8 *cmdstat,
 158                          char *cmdmsg, gfc_charlen_type command_len,
 159                          gfc_charlen_type cmdmsg_len);
 160 export_proto(execute_command_line_i8);
 161
 162 void
 163 execute_command_line_i8 (const char *command, GFC_LOGICAL_8 *wait,
 164                          GFC_INTEGER_8 *exitstat, GFC_INTEGER_8 *cmdstat,
 165                          char *cmdmsg, gfc_charlen_type command_len,
 166                          gfc_charlen_type cmdmsg_len)
 167 {
 168   bool w = wait ? *wait : true;
 169   int estat, estat_initial, cstat;
 170
 171   if (exitstat)
 172     estat_initial = estat = *exitstat;
 173
 174   execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL,
 175                         cmdmsg, command_len, cmdmsg_len);
 176
 177   if (exitstat && estat != estat_initial)
 178     *exitstat = estat;
 179   if (cmdstat)
 180     *cmdstat = cstat;
 181 }