From 70c884a4b82733027ac0e2620d09169b177080d7 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Fri, 10 Jul 2020 21:35:35 +0200 Subject: [PATCH] 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. --- gcc/fortran/class.c | 6 +++++- gcc/fortran/primary.c | 2 +- gcc/fortran/resolve.c | 19 ++++++++++++++----- gcc/testsuite/gfortran.dg/pr95980_2.f90 | 11 +++++++++++ 4 files changed, 31 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr95980_2.f90 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 d7e6acdc51c..b1238c8ab91 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 @@ -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 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 -- 2.30.2