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:
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>
|
2010-08-31 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||||
|
|
||||||
PR fortran/38282
|
PR fortran/38282
|
||||||
|
|
|
@ -362,6 +362,7 @@ enum gfc_isym_id
|
||||||
GFC_ISYM_ERFC,
|
GFC_ISYM_ERFC,
|
||||||
GFC_ISYM_ERFC_SCALED,
|
GFC_ISYM_ERFC_SCALED,
|
||||||
GFC_ISYM_ETIME,
|
GFC_ISYM_ETIME,
|
||||||
|
GFC_ISYM_EXECUTE_COMMAND_LINE,
|
||||||
GFC_ISYM_EXIT,
|
GFC_ISYM_EXIT,
|
||||||
GFC_ISYM_EXP,
|
GFC_ISYM_EXP,
|
||||||
GFC_ISYM_EXPONENT,
|
GFC_ISYM_EXPONENT,
|
||||||
|
|
|
@ -2812,6 +2812,15 @@ add_subroutines (void)
|
||||||
gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
|
gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
|
||||||
vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
|
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,
|
add_sym_1s ("fdate", GFC_ISYM_FDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
|
||||||
gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
|
gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
|
||||||
dt, BT_CHARACTER, dc, REQUIRED);
|
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_chmod_sub (gfc_code *);
|
||||||
void gfc_resolve_cpu_time (gfc_code *);
|
void gfc_resolve_cpu_time (gfc_code *);
|
||||||
void gfc_resolve_ctime_sub (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_exit (gfc_code *);
|
||||||
void gfc_resolve_fdate_sub (gfc_code *);
|
void gfc_resolve_fdate_sub (gfc_code *);
|
||||||
void gfc_resolve_flush (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}: ERFC, Complementary error function
|
||||||
* @code{ERFC_SCALED}: ERFC_SCALED, Exponentially-scaled complementary error function
|
* @code{ERFC_SCALED}: ERFC_SCALED, Exponentially-scaled complementary error function
|
||||||
* @code{ETIME}: ETIME, Execution time subroutine (or 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{EXIT}: EXIT, Exit the program with status.
|
||||||
* @code{EXP}: EXP, Exponential function
|
* @code{EXP}: EXP, Exponential function
|
||||||
* @code{EXPONENT}: EXPONENT, Exponent 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
|
@node EXIT
|
||||||
@section @code{EXIT} --- Exit the program with status.
|
@section @code{EXIT} --- Exit the program with status.
|
||||||
@fnindex EXIT
|
@fnindex EXIT
|
||||||
|
@ -10955,6 +11032,8 @@ Subroutine, function
|
||||||
@end multitable
|
@end multitable
|
||||||
|
|
||||||
@item @emph{See also}:
|
@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
|
@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. */
|
/* Resolve the EXIT intrinsic subroutine. */
|
||||||
|
|
||||||
void
|
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>
|
2010-08-31 Jakub Jelinek <jakub@redhat.com>
|
||||||
|
|
||||||
PR preprocessor/45457
|
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>
|
2010-08-29 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||||
|
|
||||||
* m4/mtype.m4 (upcase, hasmathfunc, mathfunc_macro): New macros.
|
* m4/mtype.m4 (upcase, hasmathfunc, mathfunc_macro): New macros.
|
||||||
|
|
|
@ -102,6 +102,7 @@ intrinsics/eoshift0.c \
|
||||||
intrinsics/eoshift2.c \
|
intrinsics/eoshift2.c \
|
||||||
intrinsics/erfc_scaled.c \
|
intrinsics/erfc_scaled.c \
|
||||||
intrinsics/etime.c \
|
intrinsics/etime.c \
|
||||||
|
intrinsics/execute_command_line.c \
|
||||||
intrinsics/exit.c \
|
intrinsics/exit.c \
|
||||||
intrinsics/extends_type_of.c \
|
intrinsics/extends_type_of.c \
|
||||||
intrinsics/fnum.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 \
|
am__objects_39 = associated.lo abort.lo access.lo args.lo \
|
||||||
bit_intrinsics.lo c99_functions.lo chdir.lo chmod.lo clock.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 \
|
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 \
|
env.lo eoshift0.lo eoshift2.lo erfc_scaled.lo etime.lo \
|
||||||
extends_type_of.lo fnum.lo gerror.lo getcwd.lo getlog.lo \
|
execute_command_line.lo exit.lo extends_type_of.lo fnum.lo \
|
||||||
getXid.lo hostnm.lo ierrno.lo ishftc.lo \
|
gerror.lo getcwd.lo getlog.lo getXid.lo hostnm.lo ierrno.lo \
|
||||||
iso_c_generated_procs.lo iso_c_binding.lo kill.lo link.lo \
|
ishftc.lo iso_c_generated_procs.lo iso_c_binding.lo kill.lo \
|
||||||
malloc.lo mvbits.lo move_alloc.lo pack_generic.lo perror.lo \
|
link.lo malloc.lo mvbits.lo move_alloc.lo pack_generic.lo \
|
||||||
selected_char_kind.lo signal.lo size.lo sleep.lo \
|
perror.lo selected_char_kind.lo signal.lo size.lo sleep.lo \
|
||||||
spread_generic.lo string_intrinsics.lo system.lo rand.lo \
|
spread_generic.lo string_intrinsics.lo system.lo rand.lo \
|
||||||
random.lo rename.lo reshape_generic.lo reshape_packed.lo \
|
random.lo rename.lo reshape_generic.lo reshape_packed.lo \
|
||||||
selected_int_kind.lo selected_real_kind.lo stat.lo symlnk.lo \
|
selected_int_kind.lo selected_real_kind.lo stat.lo symlnk.lo \
|
||||||
|
@ -522,6 +522,7 @@ intrinsics/eoshift0.c \
|
||||||
intrinsics/eoshift2.c \
|
intrinsics/eoshift2.c \
|
||||||
intrinsics/erfc_scaled.c \
|
intrinsics/erfc_scaled.c \
|
||||||
intrinsics/etime.c \
|
intrinsics/etime.c \
|
||||||
|
intrinsics/execute_command_line.c \
|
||||||
intrinsics/exit.c \
|
intrinsics/exit.c \
|
||||||
intrinsics/extends_type_of.c \
|
intrinsics/extends_type_of.c \
|
||||||
intrinsics/fnum.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)/erfc_scaled.Plo@am__quote@
|
||||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/error.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)/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)/exit.Plo@am__quote@
|
||||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r10.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@
|
@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@
|
@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
|
@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
|
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@ $(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
|
@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_r16;
|
||||||
_gfortran_erfc_scaled_r4;
|
_gfortran_erfc_scaled_r4;
|
||||||
_gfortran_erfc_scaled_r8;
|
_gfortran_erfc_scaled_r8;
|
||||||
|
_gfortran_execute_command_line_i4;
|
||||||
|
_gfortran_execute_command_line_i8;
|
||||||
_gfortran_pack_char4;
|
_gfortran_pack_char4;
|
||||||
_gfortran_pack_s_char4;
|
_gfortran_pack_s_char4;
|
||||||
_gfortran_reshape_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