diff options
author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2013-04-22 14:07:29 +0000 |
---|---|---|
committer | Mikael Morin <mikael@gcc.gnu.org> | 2013-04-22 14:07:29 +0000 |
commit | 9badad4aad66229c810c64917609fcefdf1b5618 (patch) | |
tree | 24a5052b6bacc50884ed2b59d769d29d9bd9be82 /gcc/fortran | |
parent | cb32de7a7d59c359cba11ea4873957b39f4ff459 (diff) |
2013-04-22 Thomas Koenig <tkoenig@gcc.gnu.org>
Mikael Morin <mikael@gcc.gnu.org>
PR fortran/56872
* frontend-passes.c (copy_walk_reduction_arg): Change argument type
to gfc_constructor. If it has an iterator, wrap the copy of its
expression in an array constructor with that iterator. Don't special
case function expressions.
(callback_reduction): Update caller. Don't return early if there is
an iterator.
2013-04-22 Thomas Koenig <tkoenig@gcc.gnu.org>
Mikael Morin <mikael@gcc.gnu.org>
PR fortran/56872
* gfortran.dg/array_constructor_45.f90: New test.
* gfortran.dg/array_constructor_46.f90: New test.
* gfortran.dg/array_constructor_47.f90: New test.
* gfortran.dg/array_constructor_40.f90: Adjust number of
while loops.
git-svn-id: https://gcc.gnu.org/svn/gcc/branches/gcc-4_8-branch@198139 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 11 | ||||
-rw-r--r-- | gcc/fortran/frontend-passes.c | 52 |
2 files changed, 43 insertions, 20 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bb01f8826f9..6967b8bb445 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2013-04-22 Thomas Koenig <tkoenig@gcc.gnu.org> + Mikael Morin <mikael@gcc.gnu.org> + + PR fortran/56872 + * frontend-passes.c (copy_walk_reduction_arg): Change argument type + to gfc_constructor. If it has an iterator, wrap the copy of its + expression in an array constructor with that iterator. Don't special + case function expressions. + (callback_reduction): Update caller. Don't return early if there is + an iterator. + 2013-04-18 Mikael Morin <mikael@gcc.gnu.org> PR fortran/56816 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 0702beb246b..fdfbce09465 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -188,37 +188,49 @@ optimize_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, old one can be freed. */ static gfc_expr * -copy_walk_reduction_arg (gfc_expr *e, gfc_expr *fn) +copy_walk_reduction_arg (gfc_constructor *c, gfc_expr *fn) { - gfc_expr *fcn; - gfc_isym_id id; + gfc_expr *fcn, *e = c->expr; - if (e->rank == 0 || e->expr_type == EXPR_FUNCTION) - fcn = gfc_copy_expr (e); - else + fcn = gfc_copy_expr (e); + if (c->iterator) + { + gfc_constructor_base newbase; + gfc_expr *new_expr; + 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, fcn, &(e->where)); + new_c->iterator = c->iterator; + new_expr->value.constructor = newbase; + c->iterator = NULL; + + fcn = new_expr; + } + + if (fcn->rank != 0) { - id = fn->value.function.isym->id; + gfc_isym_id 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, + fcn = gfc_build_intrinsic_call (current_ns, id, fn->value.function.isym->name, - fn->where, 3, gfc_copy_expr (e), - NULL, NULL); + fn->where, 3, fcn, NULL, NULL); else if (id == GFC_ISYM_ANY || id == GFC_ISYM_ALL) - fcn = gfc_build_intrinsic_call (current_ns, - fn->value.function.isym->id, + fcn = gfc_build_intrinsic_call (current_ns, id, fn->value.function.isym->name, - fn->where, 2, gfc_copy_expr (e), - NULL); + fn->where, 2, fcn, NULL); else gfc_internal_error ("Illegal id in copy_walk_reduction_arg"); fcn->symtree->n.sym->attr.access = ACCESS_PRIVATE; } - (void) gfc_expr_walker (&fcn, callback_reduction, NULL); - return fcn; } @@ -301,10 +313,10 @@ callback_reduction (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, - only have a single element in the array which contains an iterator. */ - if (c == NULL || (c->iterator != NULL && gfc_constructor_next (c) == NULL)) + if (c == NULL) return 0; - res = copy_walk_reduction_arg (c->expr, fn); + res = copy_walk_reduction_arg (c, fn); c = gfc_constructor_next (c); while (c) @@ -316,7 +328,7 @@ callback_reduction (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, 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); + new_expr->value.op.op2 = copy_walk_reduction_arg (c, fn); res = new_expr; c = gfc_constructor_next (c); } |