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_NOERROR = 0, EXEC_SYSTEMFAILED };
  42 static const char *cmdmsg_values[] =
  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 != 0)
  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, 0);
  78
  79       if ((pid = fork()) < 0)
  80         set_cmdstat (cmdstat, EXEC_SYSTEMFAILED);
  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 (!wait)
  95         set_cmdstat (cmdstat, -2);
  96       else if (res == -1)
  97         set_cmdstat (cmdstat, EXEC_SYSTEMFAILED);
  98       else
  99         {
 100           set_cmdstat (cmdstat, 0);
 101 #if defined(WEXITSTATUS) && defined(WIFEXITED)
 102           *exitstat = WIFEXITED(res) ? WEXITSTATUS(res) : res;
 103 #else
 104           *exitstat = res;
 105 #endif
 106         }
 107     }
 108
 109   /* Now copy back to the Fortran string if needed.  */
 110   if (cmdstat && *cmdstat > 0)
 111     {
 112       if (cmdmsg)
 113         fstrcpy (cmdmsg, cmdmsg_len, cmdmsg_values[*cmdstat],
 114                 strlen (cmdmsg_values[*cmdstat]));
 115       else
 116         runtime_error ("Failure in EXECUTE_COMMAND_LINE: %s",
 117                        cmdmsg_values[*cmdstat]);
 118     }
 119 }
 120
 121
 122 extern void
 123 execute_command_line_i4 (const char *command, GFC_LOGICAL_4 *wait,
 124                          GFC_INTEGER_4 *exitstat, GFC_INTEGER_4 *cmdstat,
 125                          char *cmdmsg, gfc_charlen_type command_len,
 126                          gfc_charlen_type cmdmsg_len);
 127 export_proto(execute_command_line_i4);
 128
 129 void
 130 execute_command_line_i4 (const char *command, GFC_LOGICAL_4 *wait,
 131                          GFC_INTEGER_4 *exitstat, GFC_INTEGER_4 *cmdstat,
 132                          char *cmdmsg, gfc_charlen_type command_len,
 133                          gfc_charlen_type cmdmsg_len)
 134 {
 135   bool w = wait ? *wait : true;
 136   int estat, estat_initial, cstat;
 137
 138   if (exitstat)
 139     estat_initial = estat = *exitstat;
 140
 141   execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL,
 142                         cmdmsg, command_len, cmdmsg_len);
 143
 144   if (exitstat && estat != estat_initial)
 145     *exitstat = estat;
 146   if (cmdstat)
 147     *cmdstat = cstat;
 148 }
 149
 150
 151 extern void
 152 execute_command_line_i8 (const char *command, GFC_LOGICAL_8 *wait,
 153                          GFC_INTEGER_8 *exitstat, GFC_INTEGER_8 *cmdstat,
 154                          char *cmdmsg, gfc_charlen_type command_len,
 155                          gfc_charlen_type cmdmsg_len);
 156 export_proto(execute_command_line_i8);
 157
 158 void
 159 execute_command_line_i8 (const char *command, GFC_LOGICAL_8 *wait,
 160                          GFC_INTEGER_8 *exitstat, GFC_INTEGER_8 *cmdstat,
 161                          char *cmdmsg, gfc_charlen_type command_len,
 162                          gfc_charlen_type cmdmsg_len)
 163 {
 164   bool w = wait ? *wait : true;
 165   int estat, estat_initial, cstat;
 166
 167   if (exitstat)
 168     estat_initial = estat = *exitstat;
 169
 170   execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL,
 171                         cmdmsg, command_len, cmdmsg_len);
 172
 173   if (exitstat && estat != estat_initial)
 174     *exitstat = estat;
 175   if (cmdstat)
 176     *cmdstat = cstat;
 177 }