re PR fortran/17776 (no subroutine system)

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.

From-SVN: r88532

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 249e1129b3d054cc4a379e5db0673356ff68bbf3..4260ff4ee6ddf0fc0ec4b6887e6bb2be176c525d 100644 (file)
--- 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  <schnetter@aei.mpg.de>
 
        * scanner.c (preprocessor_line): Accept preprocessor lines without

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index fc5390c667908d682fdf5967b41404fc234e9ce3..a22acf062cfd618f8f2b7caab1b12a8019a534a3 100644 (file)
--- 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 94d5374e8a3d1f9d34356f03a21b49f90e20f98d..25b7192ba717bc3a555061f628f2f490943888ee 100644 (file)
--- 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 2875321ec9a96c5ccb13cf7a53140db601b59118..aa358f0716ccacd4f3e29e6ae00ff3deba020a67 100644 (file)
--- 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 ec68828df12bbcc47f92486e24fbb9884a5025fd..c9e1dc1c0afd8ff9d7b1832ea02693b4149e8463 100644 (file)
--- 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 9ae912ef73c7488ffee682e9a285b382699d6cce..82c9b209429a4f273b8d53c49e2905bca1af9079 100644 (file)
--- 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 3b4606a6234b9f172955d1691b7cd10d8bb4ec2c..d4812acbaae29e819cb25dd32591410ead34bd9c 100644 (file)
--- 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 8b9d6a7ef4153d01ef2db42a6b416a7fa0b5d933..a66c499cb84f61078b2347a31f0479c8069d4712 100644 (file)
--- 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  <paul@codesourcery.com>
        Bud Davis  <bdavis9659@comcast.net>
 

diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index d34a3dd6e66c71913ba235d1b3eddf2f06294d94..5be4b9f0fd8477fd6bca119c6989cd94cf7683b2 100644 (file)
--- 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 219baa69b49354ee146d3b624be4569d8d579986..3fa14b49a05da2b8da64a09807227f517f608c71 100644 (file)
--- 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 (file)
index 0000000..38ae0a9
--- /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 <string.h>
+#endif
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#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;
+}