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
