[Bug fortran/106121] ICE in gfc_simplify_extends_type_of, at fortran/simplify.cc:3109

[kargl at gcc dot gnu.org via Gcc-bugs]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=106121

kargl at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
   Last reconfirmed|                            |2022-06-28
                 CC|                            |kargl at gcc dot gnu.org
             Status|UNCONFIRMED                 |NEW
     Ever confirmed|0                           |1
           Priority|P3                          |P4

--- Comment #2 from kargl at gcc dot gnu.org ---
Infamous NULL pointer dereference.

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index c8f2ef9fbf4..1a33f26932a 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -3084,6 +3084,8 @@ is_last_ref_vtab (gfc_expr *e)
 gfc_expr *
 gfc_simplify_extends_type_of (gfc_expr *a, gfc_expr *mold)
 {
+  gfc_component *ac, *mc;
+
   /* Avoid simplification of resolved symbols.  */
   if (is_last_ref_vtab (a) || is_last_ref_vtab (mold))
     return NULL;
@@ -3096,31 +3098,28 @@ gfc_simplify_extends_type_of (gfc_expr *a, gfc_expr
*mold)
   if (UNLIMITED_POLY (a) || UNLIMITED_POLY (mold))
     return NULL;

+  ac = a->ts.u.derived->components;
+  if (a->ts.type == BT_CLASS && !ac)
+    return NULL;
+
+  mc = mold->ts.u.derived->components;
+  if (mold->ts.type == BT_CLASS && !mc)
+    return NULL;
+
   /* Return .false. if the dynamic type can never be an extension.  */
   if ((a->ts.type == BT_CLASS && mold->ts.type == BT_CLASS
-       && !gfc_type_is_extension_of
-                       (mold->ts.u.derived->components->ts.u.derived,
-                        a->ts.u.derived->components->ts.u.derived)
-       && !gfc_type_is_extension_of
-                       (a->ts.u.derived->components->ts.u.derived,
-                        mold->ts.u.derived->components->ts.u.derived))
+       && !gfc_type_is_extension_of (mc->ts.u.derived, ac->ts.u.derived)
+       && !gfc_type_is_extension_of (ac->ts.u.derived, mc->ts.u.derived))
       || (a->ts.type == BT_DERIVED && mold->ts.type == BT_CLASS
-         && !gfc_type_is_extension_of
-                       (mold->ts.u.derived->components->ts.u.derived,
-                        a->ts.u.derived))
+         && !gfc_type_is_extension_of (mc->ts.u.derived, a->ts.u.derived))
       || (a->ts.type == BT_CLASS && mold->ts.type == BT_DERIVED
-         && !gfc_type_is_extension_of
-                       (mold->ts.u.derived,
-                        a->ts.u.derived->components->ts.u.derived)
-         && !gfc_type_is_extension_of
-                       (a->ts.u.derived->components->ts.u.derived,
-                        mold->ts.u.derived)))
+         && !gfc_type_is_extension_of (mold->ts.u.derived, ac->ts.u.derived)
+         && !gfc_type_is_extension_of (ac->ts.u.derived, mold->ts.u.derived)))
     return gfc_get_logical_expr (gfc_default_logical_kind, &a->where, false);

   /* Return .true. if the dynamic type is guaranteed to be an extension.  */
   if (a->ts.type == BT_CLASS && mold->ts.type == BT_DERIVED
-      && gfc_type_is_extension_of (mold->ts.u.derived,
-                                  a->ts.u.derived->components->ts.u.derived))
+      && gfc_type_is_extension_of (mold->ts.u.derived, ac->ts.u.derived))
     return gfc_get_logical_expr (gfc_default_logical_kind, &a->where, true);

   return NULL;