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