Fix PR45586 (type confusion ICEs), take 2
Michael Matz
matz@suse.de
Mon Feb 14 16:59:00 GMT 2011
Aloha,
On Mon, 14 Feb 2011, Mikael Morin wrote:
> Sorry for taking so long, I've been very doubtful about this
> error_mark_node thing, but got convinced in the end (maybe weariness
> helps ;-) ).
Thanks for the careful review, you catched some real bugs I introduced
late.
> > + if (DECL_CONTEXT (field) != TREE_TYPE (decl))
> > + {
> > + tree f2 = c->norestrict_decl;
> > + if (!f2 || DECL_FIELD_CONTEXT (f2) != TREE_TYPE (decl))
>
> Is there a reason to use DECL_FIELD_CONTEXT here and DECL_CONTEXT otherwise ?
> How different are them ?
They are exactly the same, except that DECL_FIELD_CONTEXT checks that you
give it really a FIELD_DECL. In this hunk I'm now using
DECL_FIELD_CONTEXT only. (The other hunk must continue using DECL_CONTEXT
because not all fields in a record are FIELD_DECLs).
> > tree backend_decl;
> > + /* Used to cache a FIELD_DECL matching this same component
> > + but applied to a different base type that was generated by
> a different base type sounds a bit odd.
> the target variant base type would be clearer (even if less accurate w.r.t.
> how it appears to the middle-end).
I'm now talking about containing backend type.
> > + else if (TREE_CODE (t) == POINTER_TYPE)
> > + ret = build_pointer_type (totype);
> > + else
> > + ret = build_reference_type (totype);
> > + ret = build_qualified_type (t, TYPE_QUALS (t) &~TYPE_QUAL_RESTRICT);
> Shouldn't this be...
> ret = build_qualified_type (ret, TYPE_QUALS (ret) & ~TYPE_QUAL_RESTRICT);
Nearly, it should be '= build_qualified_type (ret, TYPE_QUALS (t) ...)'.
> Also, not sure if it is applicable, but handling it the same way as in
> the other cases (via copy_node) wouldn't drop other infos (other
> qualifiers, type_lang_specific data, ...)
Generally, copy_node is a bad idea, exactly because of the sharing. For
pointer and ref types I'd have to maintain the POINTER_TO and
TYPE_CANONICAL chains myself. Going via the proper builders is more
appropriate. I'm getting away with copy_node on array and record types,
because for the former the FE explicitely doesn't want sharing, and the
latter doesn't have interesting chains or hash tables to update.
> > + else
> > + {
> > + ret = copy_node (t);
> > + TREE_TYPE (t) = elemtype;
> I think it is TREE_TYPE (ret) here.
Sigh. Indeed it is.
> > + /* ??? Change some TYPE_LANG_SPECIFICs too? */
>
> You mean GFC_TYPE_ARRAY_DATAPTR_TYPE? Yeah, it seems sensible to change
> it to the non-restrict type.
I've done that now. Given that my last patch tested okay we have nothing
in the testsuite that would make a difference here. Either because the
DATAPTR_TYPE isn't constructed yet, or because it's content isn't used
without other casts. But it's a good precaution.
> > +++ testsuite/gfortran.dg/lto/pr45586_0.f90 (Revision 0)
> > @@ -0,0 +1,29 @@
> > +! { dg-lto-do link }
> > +MODULE M1see
> Please indent the first line like the rest.
Done.
New patch below. Regstrapped without regressions on x86_64-linux (only C
and fortran this time).
Ciao,
Michael.
fortran/
PR fortran/45586
* gfortran.h (struct gfc_component): Add norestrict_decl member.
* trans.h (struct lang_type): Add nonrestricted_type member.
* trans-expr.c (gfc_conv_component_ref): Search fields with correct
parent type.
* trans-types.c (gfc_nonrestricted_type): New.
(gfc_sym_type): Use it.
testsuite/
PR fortran/45586
* gfortran.dg/lto/pr45586_0.f90: New test.
Index: trans-expr.c
===================================================================
--- trans-expr.c (revision 170097)
+++ trans-expr.c (working copy)
@@ -504,6 +504,26 @@ gfc_conv_component_ref (gfc_se * se, gfc
field = c->backend_decl;
gcc_assert (TREE_CODE (field) == FIELD_DECL);
decl = se->expr;
+
+ /* Components can correspond to fields of different containing
+ types, as components are created without context, whereas
+ a concrete use of a component has the type of decl as context.
+ So, if the type doesn't match, we search the corresponding
+ FIELD_DECL in the parent type. To not waste too much time
+ we cache this result in norestrict_decl. */
+
+ if (DECL_FIELD_CONTEXT (field) != TREE_TYPE (decl))
+ {
+ tree f2 = c->norestrict_decl;
+ if (!f2 || DECL_FIELD_CONTEXT (f2) != TREE_TYPE (decl))
+ for (f2 = TYPE_FIELDS (TREE_TYPE (decl)); f2; f2 = DECL_CHAIN (f2))
+ if (TREE_CODE (f2) == FIELD_DECL
+ && DECL_NAME (f2) == DECL_NAME (field))
+ break;
+ gcc_assert (f2);
+ c->norestrict_decl = f2;
+ field = f2;
+ }
tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
decl, field, NULL_TREE);
Index: gfortran.h
===================================================================
--- gfortran.h (revision 170097)
+++ gfortran.h (working copy)
@@ -934,6 +934,10 @@ typedef struct gfc_component
gfc_array_spec *as;
tree backend_decl;
+ /* Used to cache a FIELD_DECL matching this same component
+ but applied to a different backend containing type that was
+ generated by gfc_nonrestricted_type. */
+ tree norestrict_decl;
locus loc;
struct gfc_expr *initializer;
struct gfc_component *next;
Index: trans-types.c
===================================================================
--- trans-types.c (revision 170097)
+++ trans-types.c (working copy)
@@ -1746,6 +1746,138 @@ gfc_build_pointer_type (gfc_symbol * sym
else
return build_pointer_type (type);
}
+
+/* Given a type T, returns a different type of the same structure,
+ except that all types it refers to (recursively) are always
+ non-restrict qualified types. */
+static tree
+gfc_nonrestricted_type (tree t)
+{
+ tree ret = t;
+ if (!TYPE_LANG_SPECIFIC (t))
+ TYPE_LANG_SPECIFIC (t)
+ = ggc_alloc_cleared_lang_type (sizeof (struct lang_type));
+ /* If we're dealing with this very node already further up
+ the call chain (recursion via pointers and struct members)
+ we haven't yet determined if we really need a new type node.
+ Assume we don't, return T itself. */
+ if (TYPE_LANG_SPECIFIC (t)->nonrestricted_type == error_mark_node)
+ return t;
+
+ /* If we have calculated this all already, just return it. */
+ if (TYPE_LANG_SPECIFIC (t)->nonrestricted_type)
+ return TYPE_LANG_SPECIFIC (t)->nonrestricted_type;
+
+ /* Mark this type. */
+ TYPE_LANG_SPECIFIC (t)->nonrestricted_type = error_mark_node;
+
+ switch (TREE_CODE (t))
+ {
+ default:
+ break;
+
+ case POINTER_TYPE:
+ case REFERENCE_TYPE:
+ {
+ tree totype = gfc_nonrestricted_type (TREE_TYPE (t));
+ if (totype == TREE_TYPE (t))
+ ret = t;
+ else if (TREE_CODE (t) == POINTER_TYPE)
+ ret = build_pointer_type (totype);
+ else
+ ret = build_reference_type (totype);
+ ret = build_qualified_type (ret,
+ TYPE_QUALS (t) & ~TYPE_QUAL_RESTRICT);
+ }
+ break;
+
+ case ARRAY_TYPE:
+ {
+ tree elemtype = gfc_nonrestricted_type (TREE_TYPE (t));
+ if (elemtype == TREE_TYPE (t))
+ ret = t;
+ else
+ {
+ ret = copy_node (t);
+ TREE_TYPE (ret) = elemtype;
+ if (TYPE_LANG_SPECIFIC (t)
+ && GFC_TYPE_ARRAY_DATAPTR_TYPE (t))
+ {
+ tree dataptr_type = GFC_TYPE_ARRAY_DATAPTR_TYPE (t);
+ dataptr_type = gfc_nonrestricted_type (dataptr_type);
+ if (dataptr_type != GFC_TYPE_ARRAY_DATAPTR_TYPE (t))
+ {
+ TYPE_LANG_SPECIFIC (ret)
+ = ggc_alloc_cleared_lang_type (sizeof (struct
+ lang_type));
+ *TYPE_LANG_SPECIFIC (ret) = *TYPE_LANG_SPECIFIC (t);
+ GFC_TYPE_ARRAY_DATAPTR_TYPE (ret) = dataptr_type;
+ }
+ }
+ }
+ }
+ break;
+
+ case RECORD_TYPE:
+ case UNION_TYPE:
+ case QUAL_UNION_TYPE:
+ {
+ tree field, *chain;
+ /* First determine if we need a new type at all.
+ Careful, the two calls to gfc_nonrestricted_type per field
+ might return different values. That happens exactly when
+ one of the fields reaches back to this very record type
+ (via pointers). The first calls will assume that we don't
+ need to copy T (see the error_mark_node marking). If there
+ are any reasons for copying T apart from having to copy T,
+ we'll indeed copy it, and the second calls to
+ gfc_nonrestricted_type will use that new node if they
+ reach back to T. */
+ for (field = TYPE_FIELDS (t); field; field = DECL_CHAIN (field))
+ if (TREE_CODE (field) == FIELD_DECL)
+ {
+ tree elemtype = gfc_nonrestricted_type (TREE_TYPE (field));
+ if (elemtype != TREE_TYPE (field))
+ break;
+ }
+ if (!field)
+ break;
+ ret = copy_node (t);
+ TYPE_FIELDS (ret) = NULL_TREE;
+
+ /* Here we make sure that as soon as we know we have to copy
+ T, that also fields reaching back to us will use the new
+ copy. It's okay if that copy still contains the old fields,
+ we won't look at them. */
+ TYPE_LANG_SPECIFIC (t)->nonrestricted_type = ret;
+ chain = &TYPE_FIELDS (ret);
+ for (field = TYPE_FIELDS (t); field; field = DECL_CHAIN (field))
+ {
+ tree newfield = copy_node (field);
+ DECL_CONTEXT (newfield) = ret;
+ /* The store to DECL_CHAIN might seem redundant with the
+ stores to *chain, but not clearing it here would mean
+ leaving a chain into the old fields. If every
+ our called functions would look at them confusion
+ will arise. */
+ DECL_CHAIN (newfield) = NULL_TREE;
+ *chain = newfield;
+ chain = &DECL_CHAIN (newfield);
+
+ if (TREE_CODE (field) == FIELD_DECL)
+ {
+ tree elemtype = gfc_nonrestricted_type (TREE_TYPE (field));
+ TREE_TYPE (newfield) = elemtype;
+ }
+ }
+ *chain = NULL_TREE;
+ }
+ break;
+ }
+ TYPE_LANG_SPECIFIC (t)->nonrestricted_type = ret;
+ return ret;
+}
+
/* Return the type for a symbol. Special handling is required for character
types to get the correct level of indirection.
@@ -1796,6 +1928,9 @@ gfc_sym_type (gfc_symbol * sym)
restricted = !sym->attr.target && !sym->attr.pointer
&& !sym->attr.proc_pointer && !sym->attr.cray_pointee;
+ if (!restricted)
+ type = gfc_nonrestricted_type (type);
+
if (sym->attr.dimension)
{
if (gfc_is_nodesc_array (sym))
Index: trans.h
===================================================================
--- trans.h (revision 170097)
+++ trans.h (working copy)
@@ -700,6 +700,7 @@ struct GTY((variable_size)) lang_type {
tree dataptr_type;
tree span;
tree base_decl[2];
+ tree nonrestricted_type;
};
struct GTY((variable_size)) lang_decl {
Index: testsuite/gfortran.dg/lto/pr45586_0.f90
===================================================================
--- testsuite/gfortran.dg/lto/pr45586_0.f90 (revision 0)
+++ testsuite/gfortran.dg/lto/pr45586_0.f90 (revision 0)
@@ -0,0 +1,29 @@
+! { dg-lto-do link }
+ MODULE M1
+ INTEGER, PARAMETER :: dp=8
+ TYPE realspace_grid_type
+
+ REAL(KIND=dp), DIMENSION ( :, :, : ), ALLOCATABLE :: r
+
+ END TYPE realspace_grid_type
+ END MODULE
+
+ MODULE M2
+ USE m1
+ CONTAINS
+ SUBROUTINE S1(x)
+ TYPE(realspace_grid_type), POINTER :: x
+ REAL(dp), DIMENSION(:, :, :), POINTER :: y
+ y=>x%r
+ y=0
+
+ END SUBROUTINE
+ END MODULE
+
+ USE M2
+ TYPE(realspace_grid_type), POINTER :: x
+ ALLOCATE(x)
+ ALLOCATE(x%r(10,10,10))
+ CALL S1(x)
+ write(6,*) x%r
+ END
More information about the Fortran
mailing list