[patch, fortran] Really fix PR 56782
Mikael Morin
mikael.morin@sfr.fr
Mon Apr 15 23:28:00 GMT 2013
Le 14/04/2013 16:21, Thomas Koenig a écrit :
> 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 :-)
>
Indeed, that's right.
> 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.
Hum, how different?
> I think callback_reduction's iterator handling
>> should happen there as well.
>
> Like I said, it is done automatically by the expression
> walker.
>
I don't really understand.
Attached is what I had in mind.
And a testcase (the '|| expr->expr_type == EXPR_FUNCTION' in
copy_walk_reduction_arg appeared wrong to me, and it was seemingly).
Mikael
-------------- next part --------------
diff --git a/frontend-passes.c b/frontend-passes.c
index 9749314..cf63318 100644
--- a/frontend-passes.c
+++ b/frontend-passes.c
@@ -192,37 +192,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;
}
@@ -305,10 +317,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)
@@ -320,7 +332,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);
}
-------------- next part --------------
A non-text attachment was scrubbed...
Name: array_constructor_47.f90
Type: text/x-fortran
Size: 704 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/gcc-patches/attachments/20130415/c0259ef8/attachment.bin>
More information about the Gcc-patches
mailing list