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.

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 663102d93295e41be0d65c9218562359c67a40a0..f7d1f91f17831a924555419090a1fb9cd7df6886 100644 (file)
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -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

diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index 35dc35d2ee6b873005178105de717bbd9a46588d..7ab6923523f42a52d6d759e4a14784c36e9f1704 100644 (file)
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -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)

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index aaeaf396b91a0ba61863ba6172de78ac95eeaaf2..15db12523667ebe433a9b580f9d017737afdb30a 100644 (file)
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -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