commit 9c18db65914a751e4a1d9330ccc1659fe5ef270d
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Thu Mar 23 14:29:00 2023 +0100
Fortran: Add attr.class_ok check for generate_callback_wrapper
Proper variables/components of type BT_CLASS have 'class_ok' set; check
for that to avoid an ICE on invalid code for gfortran.dg/pr108434.f90.
gcc/fortran/
* class.cc (generate_callback_wrapper): Add attr.class_ok check.
* resolve.cc (resolve_fl_derived): Likewise.
@@ -1,3 +1,8 @@
+2023-03-23 Tobias Burnus <tobias@codesourcery.com>
+
+ * class.cc (generate_callback_wrapper): Add attr.class_ok check.
+ * resolve.cc (resolve_fl_derived): Likewise.
+
2023-03-23 Tobias Burnus <tobias@codesourcery.com>
* trans-openmp.cc (gfc_trans_omp_clauses): Fix unmapping of
@@ -2550,6 +2550,9 @@ generate_callback_wrapper (gfc_symbol *vtab, gfc_symbol *derived,
cb (token, comp->var(.data), size, 0, var's cb fn); */
for (gfc_component *comp = derived->components; comp; comp = comp->next)
{
+ if (__builtin_expect (comp->ts.type == BT_CLASS
+ && !comp->attr.class_ok, 0))
+ continue;
bool pointer = (comp->ts.type == BT_CLASS
? CLASS_DATA (comp)->attr.pointer : comp->attr.pointer);
bool proc_ptr = comp->attr.proc_pointer;
@@ -2590,7 +2593,7 @@ generate_callback_wrapper (gfc_symbol *vtab, gfc_symbol *derived,
size->where = gfc_current_locus;
}
- if (!proc_ptr && comp->ts.type == BT_CLASS)
+ if (!proc_ptr && comp->ts.type == BT_CLASS && comp->attr.class_ok)
{
gfc_add_data_component (expr);
if (comp->attr.dimension)
@@ -15173,7 +15173,8 @@ resolve_fl_derived (gfc_symbol *sym)
gfc_component *c = (sym->attr.is_class
? CLASS_DATA (sym->components) : sym->components);
for ( ; c; c = c->next)
- if ((c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
+ if ((c->ts.type == BT_DERIVED
+ || (c->ts.type == BT_CLASS && c->attr.class_ok))
&& !c->ts.u.derived->resolve_symbol_called)
{
if (c->ts.u.derived->components == NULL