Dear all, there are a couple of NULL pointer dereferences leading to improper error recovery when trying to handle Gerhard's testcases involving SELECT TYPE and invalid uses of CLASS variables.
The fixes look pretty obvious to me, but I'm submitting here to check if there is more that should be done here. (I was surprised to see that there are several different places involved by rather simple variations in the basic test case.) Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald
From 4cda248202ea741bea1dd1ca4531aa15f423801b Mon Sep 17 00:00:00 2001 From: Harald Anlauf <anl...@gmx.de> Date: Mon, 27 Dec 2021 23:06:18 +0100 Subject: [PATCH] Fortran: avoid several NULL pointer dereferences during error recovery gcc/fortran/ChangeLog: PR fortran/102332 * expr.c (gfc_get_variable_expr): Avoid NULL pointer dereferences during handling of errors with invalid uses of CLASS variables. * match.c (select_type_set_tmp): Likewise. * primary.c (gfc_match_varspec): Likewise. * resolve.c (resolve_variable): Likewise. (resolve_select_type): Likewise. gcc/testsuite/ChangeLog: PR fortran/102332 * gfortran.dg/pr102332.f90: New test. --- gcc/fortran/expr.c | 3 +- gcc/fortran/match.c | 3 +- gcc/fortran/primary.c | 1 + gcc/fortran/resolve.c | 9 +++- gcc/testsuite/gfortran.dg/pr102332.f90 | 69 ++++++++++++++++++++++++++ 5 files changed, 81 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr102332.f90 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index b874607db1d..c1258e0eb06 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -5166,7 +5166,8 @@ gfc_get_variable_expr (gfc_symtree *var) if (var->n.sym->attr.flavor != FL_PROCEDURE && ((var->n.sym->as != NULL && var->n.sym->ts.type != BT_CLASS) - || (var->n.sym->ts.type == BT_CLASS && CLASS_DATA (var->n.sym) + || (var->n.sym->ts.type == BT_CLASS && var->n.sym->ts.u.derived + && CLASS_DATA (var->n.sym) && CLASS_DATA (var->n.sym)->as))) { e->rank = var->n.sym->ts.type == BT_CLASS diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 617fb35c9cd..41faa53b97a 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -6363,7 +6363,8 @@ select_type_set_tmp (gfc_typespec *ts) sym = tmp->n.sym; gfc_add_type (sym, ts, NULL); - if (selector->ts.type == BT_CLASS && selector->attr.class_ok) + if (selector->ts.type == BT_CLASS && selector->attr.class_ok + && selector->ts.u.derived && CLASS_DATA (selector)) { sym->attr.pointer = CLASS_DATA (selector)->attr.class_pointer; diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index d873264a08e..1f63028d179 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -2151,6 +2151,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, && !(gfc_matching_procptr_assignment && sym->attr.flavor == FL_PROCEDURE)) || (sym->ts.type == BT_CLASS && sym->attr.class_ok + && sym->ts.u.derived && CLASS_DATA (sym) && (CLASS_DATA (sym)->attr.dimension || CLASS_DATA (sym)->attr.codimension))) { diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index bff1b35446f..591e8186007 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5736,6 +5736,8 @@ resolve_variable (gfc_expr *e) can't be translated that way. */ if (sym->assoc && e->rank == 0 && e->ref && sym->ts.type == BT_CLASS && sym->assoc->target && sym->assoc->target->ts.type == BT_CLASS + && sym->assoc->target->ts.u.derived + && CLASS_DATA (sym->assoc->target) && CLASS_DATA (sym->assoc->target)->as) { gfc_ref *ref = e->ref; @@ -5799,7 +5801,8 @@ resolve_variable (gfc_expr *e) /* Like above, but for class types, where the checking whether an array ref is present is more complicated. Furthermore make sure not to add the full array ref to _vptr or _len refs. */ - if (sym->assoc && sym->ts.type == BT_CLASS + if (sym->assoc && sym->ts.type == BT_CLASS && sym->ts.u.derived + && CLASS_DATA (sym) && CLASS_DATA (sym)->attr.dimension && (e->ts.type != BT_DERIVED || !e->ts.u.derived->attr.vtype)) { @@ -9432,6 +9435,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) /* Check F03:C815. */ if ((c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) + && selector_type && !selector_type->attr.unlimited_polymorphic && !gfc_type_is_extensible (c->ts.u.derived)) { @@ -9442,7 +9446,8 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) } /* Check F03:C816. */ - if (c->ts.type != BT_UNKNOWN && !selector_type->attr.unlimited_polymorphic + if (c->ts.type != BT_UNKNOWN + && selector_type && !selector_type->attr.unlimited_polymorphic && ((c->ts.type != BT_DERIVED && c->ts.type != BT_CLASS) || !gfc_type_is_extension_of (selector_type, c->ts.u.derived))) { diff --git a/gcc/testsuite/gfortran.dg/pr102332.f90 b/gcc/testsuite/gfortran.dg/pr102332.f90 new file mode 100644 index 00000000000..f9557094083 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr102332.f90 @@ -0,0 +1,69 @@ +! { dg-do compile } +! PR fortran/102332 - ICE in select_type_set_tmp +! Contributed by G.Steinmetz + +program p + type t + real :: a, b + end type + class(t), allocatable :: x ! Valid + select type (y => x) + type is (t) + y%a = 0 + end select +end + +subroutine s0 (x) + type t + real :: a, b + end type + class(t) :: x ! Valid + select type (y => x) + type is (t) + y%a = 0 + end select +end + +subroutine s1 + type t + real :: a, b + end type + class(t) :: x ! { dg-error "must be dummy, allocatable or pointer" } + select type (y => x) + type is (t) + y%a = 0 + end select +end + +subroutine s3 + type t + real :: a, b + end type + class(t) :: x ! { dg-error "must be dummy, allocatable or pointer" } + select type (y => x) + class is (t) + y%a = 0 + end select +end + +subroutine s2 + type t + real :: a, b + end type + class(t) :: x ! { dg-error "must be dummy, allocatable or pointer" } + select type (y => x) + type default ! { dg-error "Expected" } + y%a = 0 + end select +end + +subroutine s4 + type t + real :: a, b + end type + class(t) :: x ! { dg-error "must be dummy, allocatable or pointer" } + select type (y => x) + class default + y%a = 0 + end select +end -- 2.26.2