intrinsic.c: Add EXECUTE_COMMAND_LINE intrinsic.
* 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. From-SVN: r163719
This commit is contained in:
Francois-Xavier Coudert
François-Xavier Coudert
parent
d78552bd0f
commit
c14c81552a
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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 *);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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 \
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
Loading…
Reference in New Issue