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 d6847eb00048e20585e602cef4579820ad8bb550..dfa484007120307c43fe14e48d3e4bdf32fe03fd 100644 (file)
--- 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 76b1607ee3d2eecffa49e3cf7b23ae736306a54c..c0f66d3df22a8813b6b76c6d8974ea3b9a3efeef 100644 (file)
--- 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 d7e6acdc51cba147537b884351b8b7343850b721..b1238c8ab91a032f3a486a54f6e572c79200eda6 100644 (file)
--- 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
@@ -9031,7 +9033,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;
@@ -12618,7 +12620,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;
@@ -12628,7 +12631,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;
@@ -12679,6 +12683,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))
@@ -12717,7 +12722,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)
     {
@@ -15348,7 +15354,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;
@@ -15749,6 +15755,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))
@@ -15770,6 +15777,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))
@@ -15813,6 +15821,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 (file)
index 0000000..d1fe9c7
--- /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