libgfortran/intrinsics/execute_command_line.c

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