diff options
author | Francois-Xavier Coudert <coudert@clipper.ens.fr> | 2006-07-30 22:48:00 +0200 |
---|---|---|
committer | François-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2006-07-30 20:48:00 +0000 |
commit | a119fc1ca825952bcf82337a48eeef3645ec4e8d (patch) | |
tree | 42900f38bd309eacda612a5027a33176a6f75fb0 /gcc/fortran/check.c | |
parent | bd11bebe1b23ef6604982e3bc4e64e7f3adda83b (diff) | |
download | gcc-a119fc1ca825952bcf82337a48eeef3645ec4e8d.zip gcc-a119fc1ca825952bcf82337a48eeef3645ec4e8d.tar.gz gcc-a119fc1ca825952bcf82337a48eeef3645ec4e8d.tar.bz2 |
intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
(add_subroutines): Add LTIME, GMTIME and CHMOD.
* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
* check.c (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
* intrinsics/date_and_time.c: Add functions for GMTIME and LTIME.
* intrinsics/access.c: New file.
* intrinsics/chmod.c: New file.
* configure.ac: Add checks for <sys/wait.h>, access, fork,execl
and wait.
* Makefile.am: Add new files intrinsics/access.c and
intrinsics/chmod.c.
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
* gcc/testsuite/gfortran.dg/chmod_3.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test.
* gcc/testsuite/gfortran.dg/lrshift_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_2.f90: New test.
From-SVN: r115825
Diffstat (limited to 'gcc/fortran/check.c')
-rw-r--r-- | gcc/fortran/check.c | 82 |
1 files changed, 82 insertions, 0 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 4384fdb..2365822 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -443,6 +443,22 @@ gfc_check_achar (gfc_expr * a) try +gfc_check_access_func (gfc_expr * name, gfc_expr * mode) +{ + if (type_check (name, 0, BT_CHARACTER) == FAILURE + || scalar_check (name, 0) == FAILURE) + return FAILURE; + + + if (type_check (mode, 1, BT_CHARACTER) == FAILURE + || scalar_check (mode, 1) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try gfc_check_all_any (gfc_expr * mask, gfc_expr * dim) { if (logical_array_check (mask, 0) == FAILURE) @@ -678,6 +694,41 @@ gfc_check_chdir_sub (gfc_expr * dir, gfc_expr * status) try +gfc_check_chmod (gfc_expr * name, gfc_expr * mode) +{ + if (type_check (name, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (type_check (mode, 1, BT_CHARACTER) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try +gfc_check_chmod_sub (gfc_expr * name, gfc_expr * mode, gfc_expr * status) +{ + if (type_check (name, 0, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (type_check (mode, 1, BT_CHARACTER) == FAILURE) + return FAILURE; + + if (status == NULL) + return SUCCESS; + + if (type_check (status, 2, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (status, 2) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try gfc_check_cmplx (gfc_expr * x, gfc_expr * y, gfc_expr * kind) { if (numeric_check (x, 0) == FAILURE) @@ -3085,6 +3136,37 @@ gfc_check_itime_idate (gfc_expr * values) try +gfc_check_ltime_gmtime (gfc_expr * time, gfc_expr * values) +{ + if (type_check (time, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + if (kind_value_check(time, 0, gfc_default_integer_kind) == FAILURE) + return FAILURE; + + if (scalar_check (time, 0) == FAILURE) + return FAILURE; + + if (array_check (values, 1) == FAILURE) + return FAILURE; + + if (rank_check (values, 1, 1) == FAILURE) + return FAILURE; + + if (variable_check (values, 1) == FAILURE) + return FAILURE; + + if (type_check (values, 1, BT_INTEGER) == FAILURE) + return FAILURE; + + if (kind_value_check(values, 1, gfc_default_integer_kind) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try gfc_check_ttynam_sub (gfc_expr * unit, gfc_expr * name) { if (scalar_check (unit, 0) == FAILURE) |