From 82bbe4ec19209878d7c67e0b715ddd1bb4812468 Mon Sep 17 00:00:00 2001 From: tobi Date: Mon, 4 Oct 2004 21:30:32 +0000 Subject: [PATCH] fortran/ PR fortran/17776 * check.c (gfc_check_system_sub): New function. * gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SYSTEM. * intrinsic.c (add_functions): Add 'system'. (add_subroutines): Add 'system'. * intrinsic.h (gfc_check_etime_sub, gfc_check_getcwd_sub): Move prototypes to other suborutines. (gfc_check_system_sub, gfc_resolve_system, gfc_resolve_system_sub): Add prototype. (gfc_resolve_system_clock): Fix formatting of prototype. * iresolve.c (gfc_resolve_system, gfc_resolve_system_sub): New functions. * trans-intrinsic.c (gfc_conv_intrinsic_function): Deal with GFC_ISYM_SYSTEM. libgfortran/ PR fortran/17776 * intrinsics/system.c: New file. * Makefile.am: Add dependency for the new file. * Makefile.in: Regenerate. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@88532 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 16 ++++++++++- gcc/fortran/check.c | 19 +++++++++++++ gcc/fortran/gfortran.h | 1 + gcc/fortran/intrinsic.c | 9 ++++++ gcc/fortran/intrinsic.h | 9 ++++-- gcc/fortran/iresolve.c | 21 ++++++++++++++ gcc/fortran/trans-intrinsic.c | 1 + libgfortran/ChangeLog | 5 ++++ libgfortran/Makefile.am | 1 + libgfortran/Makefile.in | 20 +++++++++---- libgfortran/intrinsics/system.c | 63 +++++++++++++++++++++++++++++++++++++++++ 11 files changed, 156 insertions(+), 9 deletions(-) create mode 100644 libgfortran/intrinsics/system.c diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 249e1129b3d..4260ff4ee6d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -24,7 +24,21 @@ (parse_do_block): Generate possible END DO label inside END DO block. - + PR fortran/17776 + * check.c (gfc_check_system_sub): New function. + * gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SYSTEM. + * intrinsic.c (add_functions): Add 'system'. + (add_subroutines): Add 'system'. + * intrinsic.h (gfc_check_etime_sub, gfc_check_getcwd_sub): + Move prototypes to other suborutines. + (gfc_check_system_sub, gfc_resolve_system, gfc_resolve_system_sub): + Add prototype. + (gfc_resolve_system_clock): Fix formatting of prototype. + * iresolve.c (gfc_resolve_system, gfc_resolve_system_sub): New + functions. + * trans-intrinsic.c (gfc_conv_intrinsic_function): Deal with + GFC_ISYM_SYSTEM. + 2004-10-04 Erik Schnetter * scanner.c (preprocessor_line): Accept preprocessor lines without diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index fc5390c6679..a22acf062cf 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -2110,3 +2110,22 @@ gfc_check_getcwd_sub (gfc_expr * cwd, gfc_expr * status) return SUCCESS; } + + +try +gfc_check_system_sub (gfc_expr * cmd, gfc_expr * status) +{ + if (type_check (cmd, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (scalar_check (status, 1) == FAILURE) + return FAILURE; + + if (type_check (status, 1, BT_INTEGER) == FAILURE) + return FAILURE; + + if (kind_value_check (status, 1, gfc_default_integer_kind) == FAILURE) + return FAILURE; + + return SUCCESS; +} diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 94d5374e8a3..25b7192ba71 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -379,6 +379,7 @@ enum gfc_generic_isym_id GFC_ISYM_SQRT, GFC_ISYM_SR_KIND, GFC_ISYM_SUM, + GFC_ISYM_SYSTEM, GFC_ISYM_TAN, GFC_ISYM_TANH, GFC_ISYM_TRANSFER, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 2875321ec9a..aa358f0716c 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1775,6 +1775,10 @@ add_functions (void) make_generic ("sum", GFC_ISYM_SUM); + add_sym_1 ("system", 1, 1, BT_INTEGER, di, NULL, NULL, NULL, + c, BT_CHARACTER, dc, 0); + make_generic ("system", GFC_ISYM_SYSTEM); + add_sym_1 ("tan", 1, 1, BT_REAL, dr, NULL, gfc_simplify_tan, gfc_resolve_tan, x, BT_REAL, dr, 0); @@ -1951,6 +1955,11 @@ add_subroutines (void) gfc_check_srand, NULL, gfc_resolve_srand, c, BT_INTEGER, 4, 0); + add_sym_2s ("system", 0, 1, BT_UNKNOWN, 0, + NULL, NULL, gfc_resolve_system_sub, + c, BT_CHARACTER, dc, 0, + st, BT_INTEGER, di, 1); + add_sym_3s ("system_clock", 0, 1, BT_UNKNOWN, 0, gfc_check_system_clock, NULL, gfc_resolve_system_clock, c, BT_INTEGER, di, 1, cr, BT_INTEGER, di, 1, diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index ec68828df12..c9e1dc1c0af 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -47,8 +47,6 @@ try gfc_check_digits (gfc_expr *); try gfc_check_dot_product (gfc_expr *, gfc_expr *); try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_etime (gfc_expr *); -try gfc_check_etime_sub (gfc_expr *, gfc_expr *); -try gfc_check_getcwd_sub (gfc_expr *, gfc_expr *); try gfc_check_g77_math1 (gfc_expr *); try gfc_check_huge (gfc_expr *); try gfc_check_i (gfc_expr *); @@ -115,6 +113,9 @@ try gfc_check_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_random_number (gfc_expr *); try gfc_check_random_seed (gfc_expr *, gfc_expr *, gfc_expr *); +try gfc_check_etime_sub (gfc_expr *, gfc_expr *); +try gfc_check_getcwd_sub (gfc_expr *, gfc_expr *); +try gfc_check_system_sub (gfc_expr *, gfc_expr *); /* Simplification functions. */ @@ -311,6 +312,7 @@ void gfc_resolve_spread (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_sqrt (gfc_expr *, gfc_expr *); void gfc_resolve_srand (gfc_code *); void gfc_resolve_sum (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_system (gfc_expr *, gfc_expr *); void gfc_resolve_tan (gfc_expr *, gfc_expr *); void gfc_resolve_tanh (gfc_expr *, gfc_expr *); void gfc_resolve_transfer (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); @@ -323,8 +325,9 @@ void gfc_resolve_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); /* Intrinsic subroutine resolution. */ void gfc_resolve_cpu_time (gfc_code *); +void gfc_resolve_system_sub (gfc_code *); +void gfc_resolve_system_clock (gfc_code *); void gfc_resolve_mvbits (gfc_code *); -void gfc_resolve_system_clock(gfc_code *); void gfc_resolve_random_number (gfc_code *); void gfc_resolve_getarg (gfc_code *); void gfc_resolve_getcwd_sub (gfc_code *); diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 9ae912ef73c..82c9b209429 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -1302,6 +1302,17 @@ gfc_resolve_sum (gfc_expr * f, gfc_expr * array, gfc_expr * dim, } +/* Resolve the g77 compatibility function SYSTEM. */ + +void +gfc_resolve_system (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = 4; + f->value.function.name = gfc_get_string (PREFIX("system")); +} + + void gfc_resolve_tan (gfc_expr * f, gfc_expr * x) { @@ -1596,6 +1607,16 @@ gfc_resolve_get_environment_variable (gfc_code * code) code->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } +/* Resolve the SYSTEM intrinsic subroutine. */ + +void +gfc_resolve_system_sub (gfc_code * c) +{ + const char *name; + + name = gfc_get_string (PREFIX("system_sub")); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} /* Determine if the arguments to SYSTEM_CLOCK are INTEGER(4) or INTEGER(8) */ diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 3b4606a6234..d4812acbaae 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2973,6 +2973,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) case GFC_ISYM_GETGID: case GFC_ISYM_GETPID: case GFC_ISYM_GETUID: + case GFC_ISYM_SYSTEM: gfc_conv_intrinsic_funcall (se, expr); break; diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 8b9d6a7ef41..a66c499cb84 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -12,6 +12,11 @@ * Makefile.in: Regenerate. * intrinsics/mvbits.h: New file. + PR fortran/17776 + * intrinsics/system.c: New file. + * Makefile.am: Add dependency for the new file. + * Makefile.in: Regenerate. + 2004-10-04 Paul Brook Bud Davis diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index d34a3dd6e66..5be4b9f0fd8 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -57,6 +57,7 @@ intrinsics/pack_generic.c \ intrinsics/size.c \ intrinsics/spread_generic.c \ intrinsics/string_intrinsics.c \ +intrinsics/system.c \ intrinsics/rand.c \ intrinsics/random.c \ intrinsics/reshape_generic.c \ diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index 219baa69b49..3fa14b49a05 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -122,11 +122,11 @@ am__objects_33 = associated.lo abort.lo args.lo bessel.lo \ c99_functions.lo cpu_time.lo cshift0.lo date_and_time.lo \ env.lo erf.lo eoshift0.lo eoshift2.lo etime.lo getcwd.lo \ getXid.lo ishftc.lo mvbits.lo pack_generic.lo size.lo \ - spread_generic.lo string_intrinsics.lo rand.lo random.lo \ - reshape_generic.lo reshape_packed.lo selected_int_kind.lo \ - selected_real_kind.lo system_clock.lo transpose_generic.lo \ - unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo \ - normalize.lo + spread_generic.lo string_intrinsics.lo system.lo rand.lo \ + random.lo reshape_generic.lo reshape_packed.lo \ + selected_int_kind.lo selected_real_kind.lo system_clock.lo \ + transpose_generic.lo unpack_generic.lo in_pack_generic.lo \ + in_unpack_generic.lo normalize.lo am__objects_34 = am__objects_35 = _abs_c4.lo _abs_c8.lo _abs_i4.lo _abs_i8.lo \ _abs_r4.lo _abs_r8.lo _exp_r4.lo _exp_r8.lo _exp_c4.lo \ @@ -330,6 +330,7 @@ intrinsics/pack_generic.c \ intrinsics/size.c \ intrinsics/spread_generic.c \ intrinsics/string_intrinsics.c \ +intrinsics/system.c \ intrinsics/rand.c \ intrinsics/random.c \ intrinsics/reshape_generic.c \ @@ -2161,6 +2162,15 @@ string_intrinsics.obj: intrinsics/string_intrinsics.c string_intrinsics.lo: intrinsics/string_intrinsics.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o string_intrinsics.lo `test -f 'intrinsics/string_intrinsics.c' || echo '$(srcdir)/'`intrinsics/string_intrinsics.c +system.o: intrinsics/system.c + $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o system.o `test -f 'intrinsics/system.c' || echo '$(srcdir)/'`intrinsics/system.c + +system.obj: intrinsics/system.c + $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o system.obj `if test -f 'intrinsics/system.c'; then $(CYGPATH_W) 'intrinsics/system.c'; else $(CYGPATH_W) '$(srcdir)/intrinsics/system.c'; fi` + +system.lo: intrinsics/system.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o system.lo `test -f 'intrinsics/system.c' || echo '$(srcdir)/'`intrinsics/system.c + rand.o: intrinsics/rand.c $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rand.o `test -f 'intrinsics/rand.c' || echo '$(srcdir)/'`intrinsics/rand.c diff --git a/libgfortran/intrinsics/system.c b/libgfortran/intrinsics/system.c new file mode 100644 index 00000000000..38ae0a9d2a9 --- /dev/null +++ b/libgfortran/intrinsics/system.c @@ -0,0 +1,63 @@ +/* Implementation of the SYSTEM intrinsic. + Copyright (C) 2004 Free Software Foundation, Inc. + Contributed by Tobias Schlüter. + +This file is part of GCC. + +GCC 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 2, or (at your option) any later +version. + +In addition to the permissions in the GNU General Public License, the +Free Software Foundation gives you unlimited permission to link the +compiled version of this file into combinations with other programs, +and to distribute those combinations without any restriction coming +from the use of this file. (The General Public License restrictions +do apply in other respects; for example, they cover modification of +the file, and distribution when not linked into a combined +executable.) + +GCC 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. + +You should have received a copy of the GNU General Public License +along with GCC; see the file COPYING. If not, write to the Free +Software Foundation, 59 Temple Place - Suite 330, Boston, MA +02111-1307, USA. */ + +#include "config.h" +#include "libgfortran.h" + +#ifdef HAVE_STRING_H +#include +#endif +#ifdef HAVE_STDLIB_H +#include +#endif + +void +prefix(system_sub) (const char * fcmd, GFC_INTEGER_4 * status, + gfc_charlen_type cmd_len) +{ + char cmd[cmd_len + 1]; + int stat; + + memcpy (cmd, fcmd, cmd_len); + cmd[cmd_len] = '\0'; + + stat = system (cmd); + if (status) + *status = stat; +} + +GFC_INTEGER_4 +prefix(system) (char * fcmd, gfc_charlen_type cmd_len) +{ + GFC_INTEGER_4 stat; + + prefix(system_sub) (fcmd, &stat, cmd_len); + return stat; +} -- 2.11.0