Hello world,
the attached patch completely fixes the regression,
PR 56782.
Regression-tested. OK for trunk and 4.8?
Thomas
2013-04-14 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/56782
* frontend-passes.c (copy_walk_reduction_arg): Do not
call the expression walker with callback_reduction.
(insert_iterator_function): New function.
(callback_reduction): If an iterator is present, call
insert_iterator_function and reset the iterator on the
original array iterator.
2013-04-08 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/56782
* gfortran.dg/array_constructor_45.f90: New test.
* gfortran.dg/array_constructor_46.f90: New test.
* gfortran.dg/array_constructor_40.f90: Adjust number of
while loops.
Index: fortran/frontend-passes.c
===================================================================
--- fortran/frontend-passes.c (Revision 197610)
+++ fortran/frontend-passes.c (Arbeitskopie)
@@ -221,8 +221,47 @@ copy_walk_reduction_arg (gfc_expr *e, gfc_expr *fn
fcn->symtree->n.sym->attr.access = ACCESS_PRIVATE;
}
- (void) gfc_expr_walker (&fcn, callback_reduction, NULL);
+ return fcn;
+}
+/* Auxiliary function to create function with an an array expression with
+ iterator argument. */
+
+static gfc_expr *
+insert_iterator_function (gfc_expr *e, gfc_expr *fn, gfc_iterator *iterator)
+{
+ gfc_expr *fcn, *new_expr;
+ gfc_isym_id id;
+ gfc_constructor_base newbase;
+ gfc_constructor *new_c;
+
+ newbase = NULL;
+ new_expr = gfc_get_expr ();
+ new_expr->expr_type = EXPR_ARRAY;
+ new_expr->ts = e->ts;
+ new_expr->where = e->where;
+ new_expr->rank = 1;
+ new_c = gfc_constructor_append_expr (&newbase, gfc_copy_expr(e), &(e->where));
+ new_c->iterator = iterator;
+ new_expr->value.constructor = newbase;
+
+ id = fn->value.function.isym->id;
+
+ if (id == GFC_ISYM_SUM || id == GFC_ISYM_PRODUCT)
+ fcn = gfc_build_intrinsic_call (current_ns,
+ fn->value.function.isym->id,
+ fn->value.function.isym->name,
+ fn->where, 3, new_expr,
+ NULL, NULL);
+ else if (id == GFC_ISYM_ANY || id == GFC_ISYM_ALL)
+ fcn = gfc_build_intrinsic_call (current_ns,
+ fn->value.function.isym->id,
+ fn->value.function.isym->name,
+ fn->where, 2, new_expr,
+ NULL);
+ else
+ gfc_internal_error ("Illegal id in insert_iterator_function");
+
return fcn;
}
@@ -300,15 +339,19 @@ callback_reduction (gfc_expr **e, int *walk_subtre
c = gfc_constructor_first (arg->value.constructor);
- /* Don't do any simplififcation if we have
- - no element in the constructor or
- - only have a single element in the array which contains an
- iterator. */
+ /* Don't do any simplififcation if we have no element
+ in the constructor. */
- if (c == NULL || (c->iterator != NULL && gfc_constructor_next (c) == NULL))
+ if (c == NULL)
return 0;
- res = copy_walk_reduction_arg (c->expr, fn);
+ if (c->iterator)
+ {
+ res = insert_iterator_function (c->expr, fn, c->iterator);
+ c->iterator = NULL;
+ }
+ else
+ res = copy_walk_reduction_arg (c->expr, fn);
c = gfc_constructor_next (c);
while (c)
@@ -320,7 +363,15 @@ callback_reduction (gfc_expr **e, int *walk_subtre
new_expr->where = fn->where;
new_expr->value.op.op = op;
new_expr->value.op.op1 = res;
- new_expr->value.op.op2 = copy_walk_reduction_arg (c->expr, fn);
+
+ if (c->iterator)
+ {
+ new_expr->value.op.op2 = insert_iterator_function (c->expr, fn, c->iterator);
+ c->iterator = NULL;
+ }
+ else
+ new_expr->value.op.op2 = copy_walk_reduction_arg (c->expr, fn);
+
res = new_expr;
c = gfc_constructor_next (c);
}
Index: testsuite/gfortran.dg/array_constructor_40.f90
===================================================================
--- testsuite/gfortran.dg/array_constructor_40.f90 (Revision 197233)
+++ testsuite/gfortran.dg/array_constructor_40.f90 (Arbeitskopie)
@@ -48,5 +48,5 @@ program main
call baz(a,b,res);
if (abs(res - 8.1) > 1e-5) call abort
end program main
-! { dg-final { scan-tree-dump-times "while" 3 "original" } }
+! { dg-final { scan-tree-dump-times "while" 5 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
! { dg-do run }
! PR PR 56872 - wrong front-end optimization with a
! single array constructor and another value.
program main
real :: s
integer :: m
integer :: k
real :: res
m = 2
s = 1000.
res = SUM([3.0,(s**(REAL(k-1)/REAL(m-1)),k=1,m),17.])
if (abs(res - 1021.)>1e-4) call abort
end
! { dg-do run }
! { dg-options "-ffrontend-optimize -fdump-tree-original" }
! Test that nested array constructors are optimized.
program main
implicit none
integer, parameter :: dp=selected_real_kind(15)
real(kind=dp), dimension(2,2) :: a
real(kind=dp) thirteen
data a /2._dp,3._dp,5._dp,7._dp/
thirteen = 13._dp
if (abs (product([[11._dp, thirteen], a]) - 30030._dp) > 1e-8) call abort
end program main
! { dg-final { scan-tree-dump-times "while" 2 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
