mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-06 12:40:24 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/17776 (no subroutine system)

Browse Source 
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
This commit is contained in:
Tobias Schlüter 2004-10-04 23:30:32 +02:00 committed by Tobias Schlüter
parent 73a014b549
commit 5b1374e965
11 changed files with 156 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/fortran/ChangeLog
View File

@ -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

19
gcc/fortran/check.c
View File

@ -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;
}

1
gcc/fortran/gfortran.h
View File

@ -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,

9
gcc/fortran/intrinsic.c
View File

@ -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,

9
gcc/fortran/intrinsic.h
View File

@ -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 *);

21
gcc/fortran/iresolve.c
View File

@ -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) */

1
gcc/fortran/trans-intrinsic.c
View File

@ -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;

5
libgfortran/ChangeLog
View File

@ -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>

1
libgfortran/Makefile.am
View File

@ -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 \

20
libgfortran/Makefile.in
View File

@ -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

63
libgfortran/intrinsics/system.c Normal file
View File

@ -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;
}