Regression with SUM intrinsic
Tobias Schlüter
tobias.schlueter@physik.uni-muenchen.de
Sun Aug 22 12:10:00 GMT 2004
Steve Kargl wrote:
> It looks like the guilty commit is
>
> 2004-08-19 Erik Schnetter <schnetter@aei.mpg.de>
>
> PR fortran/16946
> * check.c (gfc_check_reduction): New function.
> (gfc_check_minval_maxval): Removed.
> (gfc_check_product): Removed.
> (gfc_check_sum): Removed.
> * intrinsic.h: Add/remove declarations for these.
> * gfortran.h: Add field f3red to union gfc_check_f.
> * intrinsic.c (add_sym_3red): New function.
> (add_functions): Register maxval, minval, product, and sum intrinsics
> through add_sym_3red.
>
Since I committed this patch, I saw it as my responsibility to fix the
problem. I committed the following as obvious after testing. I also augmented
the testcase to check that complex type arguments to PRODUCT and SUM work.
- Tobi
Index: ChangeLog
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/ChangeLog,v
retrieving revision 1.159
diff -u -p -r1.159 ChangeLog
--- ChangeLog 20 Aug 2004 13:31:08 -0000 1.159
+++ ChangeLog 22 Aug 2004 12:08:09 -0000
@@ -1,3 +1,16 @@
+2004-08-22 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
+
+ * 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 <paul@codesourcery.com>
Canqun Yang <canqun@nudt.edu.cn>
Index: check.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/check.c,v
retrieving revision 1.8
diff -u -p -r1.8 check.c
--- check.c 19 Aug 2004 15:31:37 -0000 1.8
+++ check.c 22 Aug 2004 12:08:09 -0000
@@ -1150,15 +1150,10 @@ gfc_check_minloc_maxloc (gfc_actual_argl
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;
@@ -1186,6 +1181,30 @@ gfc_check_reduction (gfc_actual_arglist
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)
{
Index: intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/intrinsic.c,v
retrieving revision 1.16
diff -u -p -r1.16 intrinsic.c
--- intrinsic.c 19 Aug 2004 15:31:37 -0000 1.16
+++ intrinsic.c 22 Aug 2004 12:08:09 -0000
@@ -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 * spec
/* 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)
Index: intrinsic.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/intrinsic.h,v
retrieving revision 1.10
diff -u -p -r1.10 intrinsic.h
--- intrinsic.h 19 Aug 2004 15:31:37 -0000 1.10
+++ intrinsic.h 22 Aug 2004 12:08:09 -0000
@@ -70,16 +70,17 @@ try gfc_check_min_max_double (gfc_actual
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 *);
More information about the Fortran
mailing list