summaryrefslogtreecommitdiff
path: root/gcc/fortran/check.c
diff options
context:
space:
mode:
authorpbrook <pbrook@138bc75d-0d04-0410-961f-82ee72b054a4>2004-06-12 17:34:47 +0000
committerpbrook <pbrook@138bc75d-0d04-0410-961f-82ee72b054a4>2004-06-12 17:34:47 +0000
commit041de113d1e6528521460bdef4687fa6cfae24c9 (patch)
treea1452828cb51b5aff27e540fe28a2545fc15adb8 /gcc/fortran/check.c
parent556d974c10227ca943ca4b03bd4760201b3fa922 (diff)
downloadgcc-041de113d1e6528521460bdef4687fa6cfae24c9.tar.gz
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions. * gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME, GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND. * trans-intrinsic.c: Use symbols. * intrinsic.c (add_sym_2s): New function. * intrinsic.c: Add etime, dtime, irand, rand, second, srand. * intrinsic.h: Function prototypes. * iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub gfc_resolve_srand): New functions. libgfortran * Makefile.am: Add rand.c and etime.c * Makefile.in: Regenerated. * aclocal.in: Regenerated. * cpu_time.c (second_sub, second): New functions. * rand.c (irand, rand, srand): New file. * etime.c (etime_sub, etime): New file. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@83034 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/check.c')
-rw-r--r--gcc/fortran/check.c113
1 files changed, 113 insertions, 0 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 007f8d975e4..cbf3d9dba7a 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1877,6 +1877,23 @@ gfc_check_random_seed (gfc_expr * size, gfc_expr * put, gfc_expr * get)
return SUCCESS;
}
+try
+gfc_check_second_sub (gfc_expr * time)
+{
+
+ if (scalar_check (time, 0) == FAILURE)
+ return FAILURE;
+
+ if (type_check (time, 0, BT_REAL) == FAILURE)
+ return FAILURE;
+
+ if (kind_value_check(time, 0, 4) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
/* The arguments of SYSTEM_CLOCK are scalar, integer variables. Note,
count, count_rate, and count_max are all optional arguments */
@@ -1935,3 +1952,99 @@ gfc_check_system_clock (gfc_expr * count, gfc_expr * count_rate,
return SUCCESS;
}
+
+try
+gfc_check_irand (gfc_expr * x)
+{
+ if (scalar_check (x, 0) == FAILURE)
+ return FAILURE;
+
+ if (type_check (x, 0, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (kind_value_check(x, 0, 4) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+try
+gfc_check_rand (gfc_expr * x)
+{
+ if (scalar_check (x, 0) == FAILURE)
+ return FAILURE;
+
+ if (type_check (x, 0, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (kind_value_check(x, 0, 4) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+try
+gfc_check_srand (gfc_expr * x)
+{
+ if (scalar_check (x, 0) == FAILURE)
+ return FAILURE;
+
+ if (type_check (x, 0, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (kind_value_check(x, 0, 4) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+try
+gfc_check_etime (gfc_expr * x)
+{
+ if (array_check (x, 0) == FAILURE)
+ return FAILURE;
+
+ if (rank_check (x, 0, 1) == FAILURE)
+ return FAILURE;
+
+ if (variable_check (x, 0) == FAILURE)
+ return FAILURE;
+
+ if (type_check (x, 0, BT_REAL) == FAILURE)
+ return FAILURE;
+
+ if (kind_value_check(x, 0, 4) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+try
+gfc_check_etime_sub (gfc_expr * values, gfc_expr * time)
+{
+ if (array_check (values, 0) == FAILURE)
+ return FAILURE;
+
+ if (rank_check (values, 0, 1) == FAILURE)
+ return FAILURE;
+
+ if (variable_check (values, 0) == FAILURE)
+ return FAILURE;
+
+ if (type_check (values, 0, BT_REAL) == FAILURE)
+ return FAILURE;
+
+ if (kind_value_check(values, 0, 4) == FAILURE)
+ return FAILURE;
+
+ if (scalar_check (time, 1) == FAILURE)
+ return FAILURE;
+
+ if (type_check (time, 1, BT_REAL) == FAILURE)
+ return FAILURE;
+
+ if (kind_value_check(time, 1, 4) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}