diff options
author | fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-09-01 08:33:11 +0000 |
---|---|---|
committer | fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-09-01 08:33:11 +0000 |
commit | fe2de951b1669a22661733f2f4496f7bcf2f02f2 (patch) | |
tree | 152b99416a290e053058a7bd41350fbc94980279 | |
parent | 278afeb5162b74e6c1f62687c48b0c437fa7eb83 (diff) | |
download | gcc-fe2de951b1669a22661733f2f4496f7bcf2f02f2.tar.gz |
* intrinsic.c: Add EXECUTE_COMMAND_LINE intrinsic.
* intrinsic.h (gfc_resolve_execute_command_line): New function.
* iresolve.c (gfc_resolve_execute_command_line): New function.
* gfortran.h (GFC_ISYM_EXECUTE_COMMAND_LINE): New value.
* intrinsic.texi: Document EXECUTE_COMMAND_LINE.
* 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.
* gfortran.dg/execute_command_line_1.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@163719 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.c | 9 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.h | 1 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.texi | 79 | ||||
-rw-r--r-- | gcc/fortran/iresolve.c | 11 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/execute_command_line_1.f90 | 60 | ||||
-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 |
13 files changed, 376 insertions, 6 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index cdceae8d02d..e943469eaf7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2010-09-01 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + * intrinsic.c: Add EXECUTE_COMMAND_LINE intrinsic. + * intrinsic.h (gfc_resolve_execute_command_line): New function. + * iresolve.c (gfc_resolve_execute_command_line): New function. + * gfortran.h (GFC_ISYM_EXECUTE_COMMAND_LINE): New value. + * intrinsic.texi: Document EXECUTE_COMMAND_LINE. + 2010-08-31 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> PR fortran/38282 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 1ee9bd58402..b23c6471a13 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -362,6 +362,7 @@ enum gfc_isym_id GFC_ISYM_ERFC, GFC_ISYM_ERFC_SCALED, GFC_ISYM_ETIME, + GFC_ISYM_EXECUTE_COMMAND_LINE, GFC_ISYM_EXIT, GFC_ISYM_EXP, GFC_ISYM_EXPONENT, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index c14e14d75cd..0b469ae08fb 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -2812,6 +2812,15 @@ add_subroutines (void) gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub, vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED); + add_sym_5s ("execute_command_line", GFC_ISYM_EXECUTE_COMMAND_LINE, + CLASS_IMPURE , BT_UNKNOWN, 0, GFC_STD_F2008, + NULL, NULL, gfc_resolve_execute_command_line, + "command", BT_CHARACTER, dc, REQUIRED, INTENT_IN, + "wait", BT_LOGICAL, dl, OPTIONAL, INTENT_IN, + "exitstat", BT_INTEGER, di, OPTIONAL, INTENT_INOUT, + "cmdstat", BT_INTEGER, di, OPTIONAL, INTENT_OUT, + "cmdmsg", BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT); + add_sym_1s ("fdate", GFC_ISYM_FDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub, dt, BT_CHARACTER, dc, REQUIRED); diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 383ada085d4..b06c65bc9e5 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -538,6 +538,7 @@ void gfc_resolve_chdir_sub (gfc_code *); void gfc_resolve_chmod_sub (gfc_code *); void gfc_resolve_cpu_time (gfc_code *); void gfc_resolve_ctime_sub (gfc_code *); +void gfc_resolve_execute_command_line (gfc_code *); void gfc_resolve_exit (gfc_code *); void gfc_resolve_fdate_sub (gfc_code *); void gfc_resolve_flush (gfc_code *); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index 49b9d53f540..6603fb59b0b 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -104,6 +104,7 @@ Some basic guidelines for editing this document: * @code{ERFC}: ERFC, Complementary error function * @code{ERFC_SCALED}: ERFC_SCALED, Exponentially-scaled complementary error function * @code{ETIME}: ETIME, Execution time subroutine (or function) +* @code{EXECUTE_COMMAND_LINE}: EXECUTE_COMMAND_LINE, Execute a shell command * @code{EXIT}: EXIT, Exit the program with status. * @code{EXP}: EXP, Exponential function * @code{EXPONENT}: EXPONENT, Exponent function @@ -3817,6 +3818,82 @@ end program test_etime +@node EXECUTE_COMMAND_LINE +@section @code{EXECUTE_COMMAND_LINE} --- Execute a shell command +@fnindex EXECUTE_COMMAND_LINE +@cindex system, system call +@cindex command line + +@table @asis +@item @emph{Description}: +@code{EXECUTE_COMMAND_LINE} runs a shell command, synchronously or +asynchronously. + +The @code{COMMAND} argument is passed to the shell and executed, using +the C library's @code{system()} call. (The shell is @code{sh} on Unix +systems, and @code{cmd.exe} on Windows.) If @code{WAIT} is present and +has the value false, the execution of the command is asynchronous if the +system supports it; otherwise, the command is executed synchronously. + +The three last arguments allow the user to get status information. After +synchronous execution, @code{EXITSTAT} contains the integer exit code of +the command, as returned by @code{system}. @code{CMDSTAT} is set to zero +if the command line was executed (whatever its exit status was). +@code{CMDMSG} is assigned an error message if an error has occurred. + + +@item @emph{Standard}: +Fortran 2008 and later + +@item @emph{Class}: +Subroutine + +@item @emph{Syntax}: +@code{CALL EXECUTE_COMMAND_LINE(COMMAND [, WAIT, EXITSTAT, CMDSTAT, CMDMSG ])} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{COMMAND} @tab Shall be a default @code{CHARACTER} scalar. +@item @var{WAIT} @tab (Optional) Shall be a default @code{LOGICAL} scalar. +@item @var{EXITSTAT} @tab (Optional) Shall be an @code{INTEGER} of the +default kind. +@item @var{CMDSTAT} @tab (Optional) Shall be an @code{INTEGER} of the +default kind. +@item @var{CMDMSG} @tab (Optional) Shall be an @code{CHARACTER} scalar of the +default kind. +@end multitable + +@item @emph{Example}: +@smallexample +program test_exec + integer :: i + + call execute_command_line ("external_prog.exe", exitstat=i) + print *, "Exit status of external_prog.exe was ", i + + call execute_command_line ("reindex_files.exe", wait=.false.) + print *, "Now reindexing files in the background" + +end program test_exec +@end smallexample + + +@item @emph{Note}: + +Because this intrinsic is implemented in terms of the @code{system()} +function call, its behavior with respect to signalling is processor +dependent. In particular, on POSIX-compliant systems, the SIGINT and +SIGQUIT signals will be ignored, and the SIGCHLD will be blocked. As +such, if the parent process is terminated, the child process might not be +terminated alongside. + + +@item @emph{See also}: +@ref{SYSTEM} +@end table + + + @node EXIT @section @code{EXIT} --- Exit the program with status. @fnindex EXIT @@ -10955,6 +11032,8 @@ Subroutine, function @end multitable @item @emph{See also}: +@ref{EXECUTE_COMMAND_LINE}, which is part of the Fortran 2008 standard +and should considered in new code for future portability. @end table diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 5a187ee455e..66df99e3bf5 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -3184,6 +3184,17 @@ gfc_resolve_system_clock (gfc_code *c) } +/* Resolve the EXECUTE_COMMAND_LINE intrinsic subroutine. */ +void +gfc_resolve_execute_command_line (gfc_code *c) +{ + const char *name; + name = gfc_get_string (PREFIX ("execute_command_line_i%d"), + gfc_default_integer_kind); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + /* Resolve the EXIT intrinsic subroutine. */ void diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d9f26d927f3..3acadbc0bab 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2010-09-01 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + * gfortran.dg/execute_command_line_1.f90: New test. + 2010-08-31 Jakub Jelinek <jakub@redhat.com> PR preprocessor/45457 diff --git a/gcc/testsuite/gfortran.dg/execute_command_line_1.f90 b/gcc/testsuite/gfortran.dg/execute_command_line_1.f90 new file mode 100644 index 00000000000..faaa860c9b4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/execute_command_line_1.f90 @@ -0,0 +1,60 @@ +! { dg-do compile } +! +! Check that we accept all variants of the EXECUTE_COMMAND_LINE intrinsic. +! + integer :: i, j + character(len=100) :: s + + s = "" + + call execute_command_line ("ls *.f90") + + print *, "-----------------------------" + + call execute_command_line ("sleep 1 ; ls *.f90", .false.) + print *, "I'm not waiting" + call sleep(2) + + print *, "-----------------------------" + + call execute_command_line ("sleep 1 ; ls *.f90", .true.) + print *, "I did wait" + call sleep(2) + + print *, "-----------------------------" + + call execute_command_line ("ls *.f90", .true., i) + print *, "Exist status was: ", i + + print *, "-----------------------------" + + call execute_command_line ("ls *.doesnotexist", .true., i) + print *, "Exist status was: ", i + + print *, "-----------------------------" + + call execute_command_line ("echo foo", .true., i, j) + print *, "Exist status was: ", i + print *, "Command status was: ", j + + print *, "-----------------------------" + + call execute_command_line ("echo foo", .true., i, j, s) + print *, "Exist status was: ", i + print *, "Command status was: ", j + print *, "Error message is: ", trim(s) + + print *, "-----------------------------" + + call execute_command_line ("ls *.doesnotexist", .true., i, j, s) + print *, "Exist status was: ", i + print *, "Command status was: ", j + print *, "Error message is: ", trim(s) + + print *, "-----------------------------" + + call execute_command_line ("sleep 20", .false.) + print *, "Please kill me with ^C" + call sleep (10) + + end 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; +} |