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

7 files changed, 72 insertions, 4 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 249e112..4260ff4 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  <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 fc5390c..a22acf0 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 94d5374..25b7192 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 2875321..aa358f07 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 ec68828..c9e1dc1 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 9ae912ef7..82c9b20 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 3b4606a..d4812ac 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;