[gfortran] Fix PR 17776: Add SYSTEM intrinsics

[Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>]

We were missing the SYSTEM intrinsic which is used to call the C library
function system(3).

Added by this. I attached two patches: one to the library, one to the
compiler, and the new file libgfortran/intrinsics/system.c

Built, tested and verified. Do we need a testcase? OK?

- Tobi

2004-10-02  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>

	PR fortran/17776
fortran/
	* 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/
	* intrinsics/system.c: New file.
	* Makefile.am: Add new file.
	
	


? 17568.diff
? 17612.diff
? 17678.diff
? 17708.diff
? 17776.diff
? alldiffs
? back
Index: check.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/check.c,v
retrieving revision 1.14
diff -u -p -r1.14 check.c
--- check.c	15 Sep 2004 14:09:05 -0000	1.14
+++ check.c	2 Oct 2004 20:20:59 -0000
@@ -2110,3 +2110,22 @@ gfc_check_getcwd_sub (gfc_expr * cwd, gf
 
   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;
+}
Index: gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.38
diff -u -p -r1.38 gfortran.h
--- gfortran.h	17 Sep 2004 17:07:43 -0000	1.38
+++ gfortran.h	2 Oct 2004 20:21:00 -0000
@@ -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,
Index: intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/intrinsic.c,v
retrieving revision 1.23
diff -u -p -r1.23 intrinsic.c
--- intrinsic.c	16 Sep 2004 16:00:42 -0000	1.23
+++ intrinsic.c	2 Oct 2004 20:21:02 -0000
@@ -1804,6 +1804,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);
 
@@ -1981,6 +1985,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,
Index: intrinsic.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/intrinsic.h,v
retrieving revision 1.16
diff -u -p -r1.16 intrinsic.h
--- intrinsic.h	24 Sep 2004 16:51:25 -0000	1.16
+++ intrinsic.h	2 Oct 2004 20:21:02 -0000
@@ -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_ex
 		      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
 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,7 +325,8 @@ void gfc_resolve_verify (gfc_expr *, gfc
 
 /* Intrinsic subroutine resolution.  */
 void gfc_resolve_cpu_time (gfc_code *);
-void gfc_resolve_system_clock(gfc_code *);
+void gfc_resolve_system_sub (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 *);
Index: iresolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/iresolve.c,v
retrieving revision 1.17
diff -u -p -r1.17 iresolve.c
--- iresolve.c	24 Sep 2004 16:51:25 -0000	1.17
+++ iresolve.c	2 Oct 2004 20:21:02 -0000
@@ -1284,6 +1284,17 @@ gfc_resolve_sum (gfc_expr * f, gfc_expr 
 }
 
 
+/* 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)
 {
@@ -1566,6 +1577,16 @@ gfc_resolve_get_environment_variable (gf
   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) */
 
Index: trans-intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-intrinsic.c,v
retrieving revision 1.26
diff -u -p -r1.26 trans-intrinsic.c
--- trans-intrinsic.c	26 Sep 2004 14:24:07 -0000	1.26
+++ trans-intrinsic.c	2 Oct 2004 20:21:03 -0000
@@ -2956,6 +2956,7 @@ gfc_conv_intrinsic_function (gfc_se * se
     case GFC_ISYM_GETGID:
     case GFC_ISYM_GETPID:
     case GFC_ISYM_GETUID:
+    case GFC_ISYM_SYSTEM:
       gfc_conv_intrinsic_funcall (se, expr);
       break;
 

Index: Makefile.am
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/Makefile.am,v
retrieving revision 1.18
diff -u -r1.18 Makefile.am
--- Makefile.am	15 Sep 2004 14:09:12 -0000	1.18
+++ Makefile.am	2 Oct 2004 20:16:17 -0000
@@ -56,6 +56,7 @@
 intrinsics/size.c \
 intrinsics/spread_generic.c \
 intrinsics/string_intrinsics.c \
+intrinsics/system.c \
 intrinsics/rand.c \
 intrinsics/random.c \
 intrinsics/reshape_generic.c \

/* 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;
}