libgfortran/intrinsics/execute_command_line.c

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