Message ID | 516A7D6C.7000801@netcologne.de |
---|---|
State | New |
Headers | show |
Hello, Le 14/04/2013 11:57, Thomas Koenig a écrit : > Hello world, > > the attached patch completely fixes the regression, > PR 56782. > typo: it's PR 56872 everywhere. > Regression-tested. OK for trunk and 4.8? > > Thomas > > 2013-04-14 Thomas Koenig <tkoenig@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 <tkoenig@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); why remove this? > + 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) > +{ [...] > + > + 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"); This duplicated code could probably be merged with copy_walk_reduction_arg. I think callback_reduction's iterator handling should happen there as well. Like this: copy_walk_reduction_arg (...) { fcn = gfc_copy_expr (c->expr); gfc_expr_walker (&fcn, callback_reduction, NULL); if (c->iterator) { /* wrap in array constructor */ } if (!scalar) { /* wrap in intrinsic call */ } return ...; } Mikael
Hi Mikael, >> >> - (void) gfc_expr_walker (&fcn, callback_reduction, NULL); > > why remove this? Because it is not needed, as the test case _46 shows. No need to run this twice, it doesn't get better :-) It is a leftover from when the callback function returned 1. gfc_internal_error ("Illegal id in insert_iterator_function"); > > This duplicated code could probably be merged with > copy_walk_reduction_arg. I thought about it. The reason why I didn't do it was because the expr to be wrapped inside the call is different. Another reason was that I didn't get it right when I tried this approach. So, I'd rather leave it as is. I think callback_reduction's iterator handling > should happen there as well. Like I said, it is done automatically by the expression walker. Thomas
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" } }