diff options
Diffstat (limited to 'libgfortran')
| -rw-r--r-- | libgfortran/ChangeLog | 8 | ||||
| -rw-r--r-- | libgfortran/Makefile.am | 1 | ||||
| -rw-r--r-- | libgfortran/Makefile.in | 21 | ||||
| -rw-r--r-- | libgfortran/gfortran.map | 2 | ||||
| -rw-r--r-- | libgfortran/intrinsics/execute_command_line.c | 177 |
5 files changed, 203 insertions, 6 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index b6fa20f8b77..51d836d7ece 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,11 @@ +2010-09-01 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + * intrinsics/execute_command_line.c: New file. + * gfortran.map (_gfortran_execute_command_line_i4, + _gfortran_execute_command_line_i8): New symbols. + * Makefile.am: Add new file intrinsics/execute_command_line.c. + * Makefile.in: Regenerated. + 2010-08-29 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> * m4/mtype.m4 (upcase, hasmathfunc, mathfunc_macro): New macros. diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index d59c6887d7f..b8dd9f89b85 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -102,6 +102,7 @@ intrinsics/eoshift0.c \ intrinsics/eoshift2.c \ intrinsics/erfc_scaled.c \ intrinsics/etime.c \ +intrinsics/execute_command_line.c \ intrinsics/exit.c \ intrinsics/extends_type_of.c \ intrinsics/fnum.c \ diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index c6f92260d2c..fa30519524d 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -225,12 +225,12 @@ am__objects_38 = close.lo file_pos.lo format.lo inquire.lo \ am__objects_39 = associated.lo abort.lo access.lo args.lo \ bit_intrinsics.lo c99_functions.lo chdir.lo chmod.lo clock.lo \ cpu_time.lo cshift0.lo ctime.lo date_and_time.lo dtime.lo \ - env.lo eoshift0.lo eoshift2.lo erfc_scaled.lo etime.lo exit.lo \ - extends_type_of.lo fnum.lo gerror.lo getcwd.lo getlog.lo \ - getXid.lo hostnm.lo ierrno.lo ishftc.lo \ - iso_c_generated_procs.lo iso_c_binding.lo kill.lo link.lo \ - malloc.lo mvbits.lo move_alloc.lo pack_generic.lo perror.lo \ - selected_char_kind.lo signal.lo size.lo sleep.lo \ + env.lo eoshift0.lo eoshift2.lo erfc_scaled.lo etime.lo \ + execute_command_line.lo exit.lo extends_type_of.lo fnum.lo \ + gerror.lo getcwd.lo getlog.lo getXid.lo hostnm.lo ierrno.lo \ + ishftc.lo iso_c_generated_procs.lo iso_c_binding.lo kill.lo \ + link.lo malloc.lo mvbits.lo move_alloc.lo pack_generic.lo \ + perror.lo selected_char_kind.lo signal.lo size.lo sleep.lo \ spread_generic.lo string_intrinsics.lo system.lo rand.lo \ random.lo rename.lo reshape_generic.lo reshape_packed.lo \ selected_int_kind.lo selected_real_kind.lo stat.lo symlnk.lo \ @@ -522,6 +522,7 @@ intrinsics/eoshift0.c \ intrinsics/eoshift2.c \ intrinsics/erfc_scaled.c \ intrinsics/etime.c \ +intrinsics/execute_command_line.c \ intrinsics/exit.c \ intrinsics/extends_type_of.c \ intrinsics/fnum.c \ @@ -1404,6 +1405,7 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/erfc_scaled.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/error.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/etime.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/execute_command_line.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exit.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r10.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r16.Plo@am__quote@ @@ -5089,6 +5091,13 @@ etime.lo: intrinsics/etime.c @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o etime.lo `test -f 'intrinsics/etime.c' || echo '$(srcdir)/'`intrinsics/etime.c +execute_command_line.lo: intrinsics/execute_command_line.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT execute_command_line.lo -MD -MP -MF $(DEPDIR)/execute_command_line.Tpo -c -o execute_command_line.lo `test -f 'intrinsics/execute_command_line.c' || echo '$(srcdir)/'`intrinsics/execute_command_line.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/execute_command_line.Tpo $(DEPDIR)/execute_command_line.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/execute_command_line.c' object='execute_command_line.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o execute_command_line.lo `test -f 'intrinsics/execute_command_line.c' || echo '$(srcdir)/'`intrinsics/execute_command_line.c + exit.lo: intrinsics/exit.c @am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT exit.lo -MD -MP -MF $(DEPDIR)/exit.Tpo -c -o exit.lo `test -f 'intrinsics/exit.c' || echo '$(srcdir)/'`intrinsics/exit.c @am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/exit.Tpo $(DEPDIR)/exit.Plo diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index f33167b1a30..72dafa6d14b 100644 --- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -1069,6 +1069,8 @@ GFORTRAN_1.1 { _gfortran_erfc_scaled_r16; _gfortran_erfc_scaled_r4; _gfortran_erfc_scaled_r8; + _gfortran_execute_command_line_i4; + _gfortran_execute_command_line_i8; _gfortran_pack_char4; _gfortran_pack_s_char4; _gfortran_reshape_char4; diff --git a/libgfortran/intrinsics/execute_command_line.c b/libgfortran/intrinsics/execute_command_line.c new file mode 100644 index 00000000000..4e3c4451d62 --- /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 +<http://www.gnu.org/licenses/>. */ + +#include "libgfortran.h" +#include <string.h> +#include <stdbool.h> + +#ifdef HAVE_STDLIB_H +#include <stdlib.h> +#endif +#ifdef HAVE_UNISTD_H +#include <unistd.h> +#endif +#ifdef HAVE_SYS_WAIT_H +#include <sys/wait.h> +#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; +} |