From patchwork Mon Dec 27 22:17:41 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 49322 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 54899385841F for ; Mon, 27 Dec 2021 22:18:30 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 54899385841F DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1640643510; bh=5D1sqkPJXp93L2tgNcQEt7xKVkZbFkJ857LpNYJWS8E=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=td4HsxwrOnWuWvMbbURIvh9tRRZM0CRiXK5Jc+pkNTLra4kIYgmn5+2HIeDXQxBpW yDQIq2vfyuAjTcaxBQp4tJg9Df9UfYRTL92fO9+Ko4lvOuUfN3cMKV4D50phDPEoJt gfkxQb3sLPvRn7Oq2wjp8jvh3Sd65z/u1DUJ49mA= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mout.gmx.net (mout.gmx.net [212.227.17.20]) by sourceware.org (Postfix) with ESMTPS id 066473858C39; Mon, 27 Dec 2021 22:17:42 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 066473858C39 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [93.207.83.92] ([93.207.83.92]) by web-mail.gmx.net (3c-app-gmx-bs23.server.lan [172.19.170.75]) (via HTTP); Mon, 27 Dec 2021 23:17:41 +0100 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] PR fortran/102332 - ICE in select_type_set_tmp, at fortran/match.c:6366 Date: Mon, 27 Dec 2021 23:17:41 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:o6jz1pVWMzMwbMbsYw8Qy31qBd4cNPiSOhtgztg+4XCNpi/Z5BCbPN+WIpLSChp/zNAuq LFgC2akicB7KLyMtUQBR1JykE8tu3F6wvSM+4I4p+vV9bissvkVe4GJ/mF9hr4VjMl+201Tcgqi7 17ApJMih+IjYPuhwRGAG0uoW7qPUmgqVn8ygjCN5jRQp6G9aVkVC2ZJGffI261lYDgYTZFg8XavA 2/nz5SzjQVRszmCQTfxoedVTXQDnzntSWiNXAwNJO4G7PQbYc02Ewply/by4HDRidBRtNoibZW0q Jg= X-UI-Out-Filterresults: notjunk:1;V03:K0:A+Ut0zQ/DGU=:lrIlUp2mWfEv6Le+krreLB pdeaeYFOHqGihWbfntFrAvIbtGhyzPE81qf+6pX01dY93CKXwJF9I+Ar+LBgdb7LgaIfvuAkn AYWdGR0cmw00QsIQuu0nlD89gL6penF6SsS+RioBIwkCsr575u1d++fWTeZ/Kqvf/422cfMCb zhaAtuIsgE0bLj89ryxRvg32T6jcpffhj02h201VIjsm3tgi/k50/0z+fFeyan8GK+BoLLuKQ rIAAMop36hT5WS24nih7Xdl1cx6EGeojRT6R+eEUD5/sEgu/nUJSh0p30Tzb+0+aD6FZdaDrM p2rfx44F4N8GYnLJALFtRpzzV9+c858GVWYvIxGS5SUWOPSH+uFQBMzE+iL5dnQHiy45n1Iu0 L/+kmZESBjwg2IJRlO1ln1IAL3mVsccPmInz8iRkYg6fgOhDZOvf3EeF7t0FPDXxqysUrHY3u 6Gb2lRyNHyj3Zw+0qJydhSJtnxX6/7pNRRIG795iJAV1ZmUoPfjAY2i3Oi1jMtAspWS5go1JT 7GXPQMEmqIzdBsRoPSW7WPc+j0LdAOPJMvVB7xGJGkcMeP+nUgOLRfWC53pGvZUKpIkE2JTnq FGqfhqgs/kskTmXzO+/hX6cpB4FaN7elsNFINhTptpTK5KsdREI+XTcJmdO+yaKlnWdP4Mhjq xuEKlShjv5WusUeDsEAEcpyANW0KhbfPIz3Z2wzBX6D20RX8MRliQ12EV7RQD/4vxXVQkYQdw qE8C6bb4D3zaFAX1n9yJ1tmvjZwfXg2o1KXxIwobMT0cSkSfobpa8mwgFCU= X-Spam-Status: No, score=-11.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, KAM_NUMSUBJECT, RCVD_IN_DNSWL_NONE, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Harald Anlauf via Gcc-patches From: Harald Anlauf Reply-To: Harald Anlauf Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" 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 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