------- Comment #6 from pault at gcc dot gnu dot org 2007-08-18 06:04 -------
This one is a real head-banger. The array element reference is being
completely ignored in translation. I tried simplifying it by grabbing out the
array component and attaching the array reference to it. The resulting
expression looks fine but the reference is ignore further downstream; I have
run out of time to look at this, for a while. Note that replacing the array
component of a derived type parameter with a parameter array works fine.
Just for the record, my attempt to fix this by simplification appears below.
Paul
Index: gcc/fortran/expr.c
===================================================================
*** gcc/fortran/expr.c (revision 127505)
--- gcc/fortran/expr.c (working copy)
*************** simplify_ref_chain (gfc_ref *ref, int ty
*** 1461,1466 ****
--- 1461,1535 ----
}
+ /* Simplify structure references. */
+
+ static void
+ simplify_structure_refs (gfc_expr *e)
+ {
+ int n;
+ bool seen_array_ref;
+ bool reduced_structure = false;
+ gfc_ref *ref;
+ gfc_component *cmp;
+ gfc_constructor *ctr;
+ gfc_expr *p = e;
+ gfc_symtree *st;
+
+ if (e->expr_type != EXPR_STRUCTURE)
+ return;
+
+ start:
+ seen_array_ref = false;
+ ref = p->ref;
+
+ for (; ref; ref = ref->next)
+ {
+ switch (ref->type)
+ {
+ case REF_COMPONENT:
+ if (p->symtree
+ && p->symtree->n.sym->ts.derived
+ && !p->ts.derived)
+ p->ts = p->symtree->n.sym->ts;
+
+ if (seen_array_ref || !p->ts.derived)
+ break;
+
+ ctr = p->value.constructor;
+ cmp = p->ts.derived->components;
+ for (;ctr; ctr = ctr->next, cmp = cmp->next)
+ {
+ if (ref->u.c.component != cmp || ctr->expr == NULL)
+ continue;
+ p = ctr->expr;
+ p->ts = cmp->ts;
+ ctr->expr = NULL;
+ p->ref = ref->next;
+ ref->next = NULL;
+ gfc_free_expr (e);
+ *e = *p;
+ reduced_structure = true;
+ goto start;
+ }
+ break;
+
+ case REF_ARRAY:
+ for (n = 0; n < ref->u.ar.dimen; n++)
+ {
+ if (reduced_structure
+ && ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
+ p->rank--;
+ }
+ seen_array_ref = true;
+ break;
+
+ default:
+ break;
+ }
+ }
+ }
+
+
/* Try to substitute the value of a parameter variable. */
static try
*************** gfc_simplify_expr (gfc_expr *p, int type
*** 1604,1609 ****
--- 1673,1681 ----
if (simplify_ref_chain (p->ref, type) == FAILURE)
return FAILURE;
+ if (p->ref)
+ simplify_structure_refs (p);
+
if (simplify_constructor (p->value.constructor, type) == FAILURE)
return FAILURE;
*************** gfc_check_pointer_assign (gfc_expr *lval
*** 2749,2755 ****
is_pure = gfc_pure (NULL);
! if (is_pure && gfc_impure_variable (lvalue->symtree->n.sym))
{
gfc_error ("Bad pointer object in PURE procedure at %L",
&lvalue->where)
;
return FAILURE;
--- 2821,2828 ----
is_pure = gfc_pure (NULL);
! if (is_pure && gfc_impure_variable (lvalue->symtree->n.sym)
! && lvalue->symtree->n.sym->value != rvalue)
{
gfc_error ("Bad pointer object in PURE procedure at %L",
&lvalue->where)
;
return FAILURE;
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=31564
