From 617097a3374140b8ec5a4e991ff69fbe94329b74 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Tobias=20Schl=C3=BCter?= Date: Sun, 22 Aug 2004 14:09:26 +0200 Subject: [PATCH] check.c (gfc_check_reduction): Rename to ... * check.c (gfc_check_reduction): Rename to ... (check_reduction): ... this. Make static. Don't check type of first argument. (gfc_check_minval_maxval, gfc_check_prodcut_sum): New functions. * intrinsic.c (add_functions): Change MAXVAL, MINVAL, PRODUCT and SUM to use new check functions. (check_specific): Change logic to call new functions. * intrinsic.h (gfc_check_minval_maxval, gfc_check_product_sum): Add prototypes. (gfc_check_reduction): Remove prototype. From-SVN: r86377 --- gcc/fortran/ChangeLog | 13 +++++++++++++ gcc/fortran/check.c | 35 +++++++++++++++++++++++++++-------- gcc/fortran/intrinsic.c | 16 ++++++++++------ gcc/fortran/intrinsic.h | 3 ++- 4 files changed, 52 insertions(+), 15 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index fed67a6cb07..d9c4d5fb332 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2004-08-22 Tobias Schlueter + + * check.c (gfc_check_reduction): Rename to ... + (check_reduction): ... this. Make static. Don't check type of + first argument. + (gfc_check_minval_maxval, gfc_check_prodcut_sum): New functions. + * intrinsic.c (add_functions): Change MAXVAL, MINVAL, PRODUCT and + SUM to use new check functions. + (check_specific): Change logic to call new functions. + * intrinsic.h (gfc_check_minval_maxval, gfc_check_product_sum): + Add prototypes. + (gfc_check_reduction): Remove prototype. + 2004-08-20 Paul Brook Canqun Yang diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index aff024a5874..9e5906a985e 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1150,15 +1150,10 @@ gfc_check_minloc_maxloc (gfc_actual_arglist * ap) I.e. in the case of minval(array,mask), mask will be in the second position of the argument list and we'll have to fix that up. */ -try -gfc_check_reduction (gfc_actual_arglist * ap) +static try +check_reduction (gfc_actual_arglist * ap) { - gfc_expr *a, *m, *d; - - a = ap->expr; - if (int_or_real_check (a, 0) == FAILURE - || array_check (a, 0) == FAILURE) - return FAILURE; + gfc_expr *m, *d; d = ap->next->expr; m = ap->next->next->expr; @@ -1185,6 +1180,30 @@ gfc_check_reduction (gfc_actual_arglist * ap) } +try +gfc_check_minval_maxval (gfc_actual_arglist * ap) +{ + + if (int_or_real_check (ap->expr, 0) == FAILURE + || array_check (ap->expr, 0) == FAILURE) + return FAILURE; + + return check_reduction (ap); +} + + +try +gfc_check_product_sum (gfc_actual_arglist * ap) +{ + + if (numeric_check (ap->expr, 0) == FAILURE + || array_check (ap->expr, 0) == FAILURE) + return FAILURE; + + return check_reduction (ap); +} + + try gfc_check_merge (gfc_expr * tsource, gfc_expr * fsource, gfc_expr * mask) { diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 00cdecf87da..2784a7a03ea 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1406,7 +1406,7 @@ add_functions (void) make_generic ("maxloc", GFC_ISYM_MAXLOC); add_sym_3red ("maxval", 0, 1, BT_REAL, dr, - gfc_check_reduction, NULL, gfc_resolve_maxval, + gfc_check_minval_maxval, NULL, gfc_resolve_maxval, ar, BT_REAL, dr, 0, dm, BT_INTEGER, ii, 1, msk, BT_LOGICAL, dl, 1); @@ -1461,7 +1461,7 @@ add_functions (void) make_generic ("minloc", GFC_ISYM_MINLOC); add_sym_3red ("minval", 0, 1, BT_REAL, dr, - gfc_check_reduction, NULL, gfc_resolve_minval, + gfc_check_minval_maxval, NULL, gfc_resolve_minval, ar, BT_REAL, dr, 0, dm, BT_INTEGER, ii, 1, msk, BT_LOGICAL, dl, 1); @@ -1534,7 +1534,7 @@ add_functions (void) make_generic ("present", GFC_ISYM_PRESENT); add_sym_3red ("product", 0, 1, BT_REAL, dr, - gfc_check_reduction, NULL, gfc_resolve_product, + gfc_check_product_sum, NULL, gfc_resolve_product, ar, BT_REAL, dr, 0, dm, BT_INTEGER, ii, 1, msk, BT_LOGICAL, dl, 1); @@ -1716,7 +1716,7 @@ add_functions (void) make_generic ("sqrt", GFC_ISYM_SQRT); add_sym_3red ("sum", 0, 1, BT_UNKNOWN, 0, - gfc_check_reduction, NULL, gfc_resolve_sum, + gfc_check_product_sum, NULL, gfc_resolve_sum, ar, BT_REAL, dr, 0, dm, BT_INTEGER, ii, 1, msk, BT_LOGICAL, dl, 1); @@ -2493,10 +2493,14 @@ check_specific (gfc_intrinsic_sym * specific, gfc_expr * expr, int error_flag) /* This is special because we might have to reorder the argument list. */ t = gfc_check_minloc_maxloc (*ap); - else if (specific->check.f3red == gfc_check_reduction) + else if (specific->check.f3red == gfc_check_minval_maxval) /* This is also special because we also might have to reorder the argument list. */ - t = gfc_check_reduction (*ap); + t = gfc_check_minval_maxval (*ap); + else if (specific->check.f3red == gfc_check_product_sum) + /* Same here. The difference to the previous case is that we allow a + general numeric type. */ + t = gfc_check_product_sum (*ap); else { if (specific->check.f1 == NULL) diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 0eeeaf96e85..d09bcd02964 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -70,16 +70,17 @@ try gfc_check_min_max_double (gfc_actual_arglist *); try gfc_check_matmul (gfc_expr *, gfc_expr *); try gfc_check_merge (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_minloc_maxloc (gfc_actual_arglist *); +try gfc_check_minval_maxval (gfc_actual_arglist *); try gfc_check_nearest (gfc_expr *, gfc_expr *); try gfc_check_null (gfc_expr *); try gfc_check_pack (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_precision (gfc_expr *); try gfc_check_present (gfc_expr *); +try gfc_check_product_sum (gfc_actual_arglist *); try gfc_check_radix (gfc_expr *); try gfc_check_rand (gfc_expr *); try gfc_check_range (gfc_expr *); try gfc_check_real (gfc_expr *, gfc_expr *); -try gfc_check_reduction (gfc_actual_arglist *); try gfc_check_repeat (gfc_expr *, gfc_expr *); try gfc_check_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_scale (gfc_expr *, gfc_expr *); -- 2.30.2