As Dominique pointed out in the PR, the committed patch (part 1) fixed only
one of the provided testcases, but not the original one.  That turned out
to be a long and winding road, requiring further checks for NULL pointer
dereferences.

The resulting attached changes have been regtested on x86_64-pc-linux-gnu
and confirmed on Darwin by Dominique (thanks!), see PR.

OK for master / where appropriate?

Thanks,
Harald


PR fortran/95980 - ICE in get_unique_type_string, at fortran/class.c:485

In SELECT TYPE, the argument may be an incorrectly specified unlimited
CLASS variable.  Avoid NULL pointer dereferences for clean error
recovery.

gcc/fortran/
        PR fortran/95980
        * class.c (gfc_add_component_ref, gfc_build_class_symbol):
        Add checks for NULL pointer dereference.
        * primary.c (gfc_variable_attr): Likewise.
        * resolve.c (resolve_variable, resolve_assoc_var)
        (resolve_fl_var_and_proc, resolve_fl_variable_derived)
        (resolve_symbol): Likewise.

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index d6847eb0004..dfa48400712 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -228,7 +228,7 @@ gfc_add_component_ref (gfc_expr *e, const char *name)
 	break;
       tail = &((*tail)->next);
     }
-  if (derived->components && derived->components->next &&
+  if (derived && derived->components && derived->components->next &&
       derived->components->next->ts.type == BT_DERIVED &&
       derived->components->next->ts.u.derived == NULL)
     {
@@ -663,6 +663,10 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,

   /* Determine the name of the encapsulating type.  */
   rank = !(*as) || (*as)->rank == -1 ? GFC_MAX_DIMENSIONS : (*as)->rank;
+
+  if (!ts->u.derived)
+    return false;
+
   get_unique_hashed_string (tname, ts->u.derived);
   if ((*as) && attr->allocatable)
     name = xasprintf ("__class_%s_%d_%da", tname, rank, (*as)->corank);
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 76b1607ee3d..c0f66d3df22 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2597,7 +2597,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
   sym = expr->symtree->n.sym;
   attr = sym->attr;

-  if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
+  if (sym->ts.type == BT_CLASS && sym->attr.class_ok && sym->ts.u.derived)
     {
       dimension = CLASS_DATA (sym)->attr.dimension;
       codimension = CLASS_DATA (sym)->attr.codimension;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 223dcccce91..47a619c56b2 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5571,6 +5571,7 @@ resolve_variable (gfc_expr *e)
     }
   /* TS 29113, C535b.  */
   else if (((sym->ts.type == BT_CLASS && sym->attr.class_ok
+	     && sym->ts.u.derived && CLASS_DATA (sym)
 	     && CLASS_DATA (sym)->as
 	     && CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK)
 	    || (sym->ts.type != BT_CLASS && sym->as
@@ -5618,6 +5619,7 @@ resolve_variable (gfc_expr *e)

   /* TS 29113, C535b.  */
   if (((sym->ts.type == BT_CLASS && sym->attr.class_ok
+	&& sym->ts.u.derived && CLASS_DATA (sym)
 	&& CLASS_DATA (sym)->as
 	&& CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK)
        || (sym->ts.type != BT_CLASS && sym->as
@@ -9029,7 +9031,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
     {
       /* target's rank is 0, but the type of the sym is still array valued,
 	 which has to be corrected.  */
-      if (sym->ts.type == BT_CLASS
+      if (sym->ts.type == BT_CLASS && sym->ts.u.derived
 	  && CLASS_DATA (sym) && CLASS_DATA (sym)->as)
 	{
 	  gfc_array_spec *as;
@@ -12615,7 +12617,8 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
 {
   gfc_array_spec *as;

-  if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
+  if (sym->ts.type == BT_CLASS && sym->attr.class_ok
+      && sym->ts.u.derived && CLASS_DATA (sym))
     as = CLASS_DATA (sym)->as;
   else
     as = sym->as;
@@ -12625,7 +12628,8 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
     {
       bool pointer, allocatable, dimension;

-      if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
+      if (sym->ts.type == BT_CLASS && sym->attr.class_ok
+	  && sym->ts.u.derived && CLASS_DATA (sym))
 	{
 	  pointer = CLASS_DATA (sym)->attr.class_pointer;
 	  allocatable = CLASS_DATA (sym)->attr.allocatable;
@@ -12676,6 +12680,7 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
     {
       /* F03:C502.  */
       if (sym->attr.class_ok
+	  && sym->ts.u.derived
 	  && !sym->attr.select_type_temporary
 	  && !UNLIMITED_POLY (sym)
 	  && !gfc_type_is_extensible (CLASS_DATA (sym)->ts.u.derived))
@@ -12714,7 +12719,8 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag)
      associated by the presence of another class I symbol in the same
      namespace.  14.6.1.3 of the standard and the discussion on
      comp.lang.fortran.  */
-  if (sym->ns != sym->ts.u.derived->ns
+  if (sym->ts.u.derived
+      && sym->ns != sym->ts.u.derived->ns
       && !sym->ts.u.derived->attr.use_assoc
       && sym->ns->proc_name->attr.if_source != IFSRC_IFBODY)
     {
@@ -15345,7 +15351,7 @@ resolve_symbol (gfc_symbol *sym)
       specification_expr = saved_specification_expr;
     }

-  if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
+  if (sym->ts.type == BT_CLASS && sym->attr.class_ok && sym->ts.u.derived)
     {
       as = CLASS_DATA (sym)->as;
       class_attr = CLASS_DATA (sym)->attr;
@@ -15746,6 +15752,7 @@ resolve_symbol (gfc_symbol *sym)
   /* F2008, C525.  */
   if ((((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
 	 || (sym->ts.type == BT_CLASS && sym->attr.class_ok
+	     && sym->ts.u.derived && CLASS_DATA (sym)
 	     && CLASS_DATA (sym)->attr.coarray_comp))
        || class_attr.codimension)
       && (sym->attr.result || sym->result == sym))
@@ -15767,6 +15774,7 @@ resolve_symbol (gfc_symbol *sym)
   /* F2008, C525.  */
   if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
 	|| (sym->ts.type == BT_CLASS && sym->attr.class_ok
+	    && sym->ts.u.derived && CLASS_DATA (sym)
 	    && CLASS_DATA (sym)->attr.coarray_comp))
       && (class_attr.codimension || class_attr.pointer || class_attr.dimension
 	  || class_attr.allocatable))
@@ -15810,6 +15818,7 @@ resolve_symbol (gfc_symbol *sym)
   /* F2008, C541.  */
   if ((((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
 	|| (sym->ts.type == BT_CLASS && sym->attr.class_ok
+	    && sym->ts.u.derived && CLASS_DATA (sym)
 	    && CLASS_DATA (sym)->attr.coarray_comp))
        || (class_attr.codimension && class_attr.allocatable))
       && sym->attr.dummy && sym->attr.intent == INTENT_OUT)
diff --git a/gcc/testsuite/gfortran.dg/pr95980_2.f90 b/gcc/testsuite/gfortran.dg/pr95980_2.f90
new file mode 100644
index 00000000000..d1fe9c76bd0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr95980_2.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR fortran/95980 - ICE in get_unique_type_string, at fortran/class.c:485
+
+program p
+  type t
+     integer :: a
+  end type t
+  class(t) :: x         ! { dg-error "must be dummy, allocatable or pointer" }
+  select type (y => x)
+  end select
+end

Reply via email to