From patchwork Thu Oct 26 17:14:38 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 158625 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:d641:0:b0:403:3b70:6f57 with SMTP id cy1csp35962vqb; Thu, 26 Oct 2023 10:15:19 -0700 (PDT) X-Google-Smtp-Source: AGHT+IGzyLgA55DX48hvOsuhlFtcZDa6LbNcOVByhr3M9iSlnqKk3wNaSmO+u6msvZnWVAD+zQOE X-Received: by 2002:a05:620a:1108:b0:76e:fea2:cc79 with SMTP id o8-20020a05620a110800b0076efea2cc79mr17814847qkk.67.1698340519630; Thu, 26 Oct 2023 10:15:19 -0700 (PDT) Received: from server2.sourceware.org (server2.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id x25-20020ae9f819000000b0076eed2a7335si9796247qkh.57.2023.10.26.10.15.19 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 26 Oct 2023 10:15:19 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=neutral (body hash did not verify) header.i=@gmail.com header.s=20230601 header.b=Jcqvaco5; arc=fail (body hash mismatch); spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=fail (p=NONE sp=QUARANTINE dis=NONE) header.from=gmail.com Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 651533858002 for ; Thu, 26 Oct 2023 17:15:19 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-pj1-x1031.google.com (mail-pj1-x1031.google.com [IPv6:2607:f8b0:4864:20::1031]) by sourceware.org (Postfix) with ESMTPS id 322423858D20; Thu, 26 Oct 2023 17:14:51 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 322423858D20 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmail.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 322423858D20 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2607:f8b0:4864:20::1031 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1698340494; cv=none; b=bzsdPXow7toJhKSXK9FawyccJ0ZhPIHyzu1CKH2/sNrkTvMHJP5m3rhTg/qhMJRpzlnhRam4b2F3vO/CvyOHBt/Ir9hLIr8sMpHcfs8Lc/7lrrxfNSnvZ5eyQXRvw1eU1n/kKK2tg0h0MHSdI72edghRcYT6H9ghVTgRqTC5Y0I= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1698340494; c=relaxed/simple; bh=bgi887t6sPfFrMn/tuzQe5qapkgKakR3pL32y4KM+XQ=; h=DKIM-Signature:MIME-Version:From:Date:Message-ID:Subject:To; b=GFyVOVRFrS5qUmpSY8rrExXq/sM/hOvPM71770rNLGennFyh/wYuSl+aWaII4J5EV5bPTFeRHdNEX+8kbG9IQM28RHJTBkO9ibAE9Smoqgi8qh2bUg7swhxEc4gWSxfD/Jvg+zbif8lT3h86Cfq2TjmPg2Xgsx5RUqSWKTKfplo= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-pj1-x1031.google.com with SMTP id 98e67ed59e1d1-27d425a2dd0so955781a91.2; Thu, 26 Oct 2023 10:14:51 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1698340490; x=1698945290; darn=gcc.gnu.org; h=to:subject:message-id:date:from:mime-version:from:to:cc:subject :date:message-id:reply-to; bh=Lj4cG0BYwPdLAXRGcAi1MkFbJ+Fd87CaHpKHlTirvdc=; b=Jcqvaco5NACBdCVy7Cc6pkbVLHKz3QiRUxwhPzc45yoN4gCPWigcu5xcuJ/NfEeYNp Ta5nnusj+lwxT+nh0/O26KDKqlg1POnYGBepzotQs1Cb2AgN2fTYTIeQlWrw+9GeTX7O j7TCfnREMoaM2BkA6CcqLYdfSAD8Fwm5PJ2ZxRXSmGr30vpLN8fPmfxhukr6K3F0cTd4 k8+lZy/jtt4RfydTptHnyXi7zUiS+xfs1gOBnd/nOwpFWI8PGweKTGhonbyCXGhq+/a2 uz4wKzR24Nqg2C7/2CYelbc4h9tJThTdESb9HtKBLh1tvJTj5334RkIVuOX/8/zJFJzE SVAQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1698340490; x=1698945290; h=to:subject:message-id:date:from:mime-version:x-gm-message-state :from:to:cc:subject:date:message-id:reply-to; bh=Lj4cG0BYwPdLAXRGcAi1MkFbJ+Fd87CaHpKHlTirvdc=; b=pxzPsC1lZfv9Perh//90l+Mmfn/jfyLURG1bXBTpSpkBeHdCkeA5lmCMhQxrr/T0N4 L6e6qbHDXokqNyIPpctRuHjTaMOvU63IFhjkNrV4YBdwmT/24hHrIoXSWaj8YNGaZLur IAdQglafo8kPRhyPLhFIguyJiC5WikxNOeK0ZWdkOwEdcDujHXI9tOjpYMfa25/vdtpk bP3fzpG5z3NZECVTb7zcUqF6p3CDQqRG54cOsUmhHEVHpD4aXtzUmSI/51zIy3lxieaN kf4GuemcEvHroufa+SyId5qKFn0H7edJ34Ca1fIYmS9XpvV+EVdvLkxDn3vCw+QVbj9G 1QIg== X-Gm-Message-State: AOJu0Yyu3KEInVIBFB4WCbUglsuHaySvWBdjEhrLCHQcaH5rFVMZ3b56 29RGjp7WSbkR9/k0rFv8j5vMVowuzV4cdgejV4PDi0GzRew= X-Received: by 2002:a17:90a:f30d:b0:27d:2cc3:c805 with SMTP id ca13-20020a17090af30d00b0027d2cc3c805mr62251pjb.46.1698340489681; Thu, 26 Oct 2023 10:14:49 -0700 (PDT) MIME-Version: 1.0 From: Paul Richard Thomas Date: Thu, 26 Oct 2023 18:14:38 +0100 Message-ID: Subject: [Patch, fortran] PR104625 ICE in fixup_array_ref, at fortran/resolve.cc:9275 since r10-2912-g70570ec192745095 To: "fortran@gcc.gnu.org" , gcc-patches , Harald Anlauf X-Spam-Status: No, score=-7.2 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, HTML_MESSAGE, KAM_NUMSUBJECT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, WEIRD_PORT autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1780839108786253091 X-GMAIL-MSGID: 1780839108786253091 Hi All, The attached patch fixes the original problem, in which parentheses around the selector in select type constructs caused ICES. Stacked parentheses caused problems in trans-stmt.cc. Rather than tracking this down, the redundant parentheses were removed on resolution of the selector expression. Fixing the primary problem revealed "Unclassifiable statement" errors when using array references of the associate variable and this was fixed as well. Finally, the error triggered by using associate variables associated with non-variable selectors was corrected to ensure that only vector indexed selectors were flagged up as such. The secondary error in associate_55.f90 was corrected for this, since the selector might or might not be vector indexed. Regtests fine - OK for trunk? Paul Fortran: Fix some problems with SELECT TYPE selectors [PR104625]. 2023-10-26 Paul Thomas gcc/fortran PR fortran/104625 * expr.cc (gfc_check_vardef_context): Check that the target does have a vector index before emitting the specific error. * match.cc (copy_ts_from_selector_to_associate): Ensure that class valued operator expressions set the selector rank and use the rank to provide the associate variable with an appropriate array spec. * resolve.cc (resolve_operator): Reduce stacked parentheses to a single pair. (fixup_array_ref): Extract selector symbol from parentheses. gcc/testsuite/ PR fortran/104625 * gfortran.dg/pr104625.f90: New test. * gfortran.dg/associate_55.f90: Change error check text. diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index 663fe63dea6..c668baeef8c 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -6474,7 +6474,8 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, { if (context) { - if (assoc->target->expr_type == EXPR_VARIABLE) + if (assoc->target->expr_type == EXPR_VARIABLE + && gfc_has_vector_index (assoc->target)) gfc_error ("%qs at %L associated to vector-indexed target" " cannot be used in a variable definition" " context (%s)", diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc index c926f38058f..05995c6f97f 100644 --- a/gcc/fortran/match.cc +++ b/gcc/fortran/match.cc @@ -6341,12 +6341,13 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector) else if (selector->ts.type == BT_CLASS && CLASS_DATA (selector) && CLASS_DATA (selector)->as - && ref && ref->type == REF_ARRAY) + && ((ref && ref->type == REF_ARRAY) + || selector->expr_type == EXPR_OP)) { /* Ensure that the array reference type is set. We cannot use gfc_resolve_expr at this point, so the usable parts of resolve.cc(resolve_array_ref) are employed to do it. */ - if (ref->u.ar.type == AR_UNKNOWN) + if (ref && ref->u.ar.type == AR_UNKNOWN) { ref->u.ar.type = AR_ELEMENT; for (int i = 0; i < ref->u.ar.dimen + ref->u.ar.codimen; i++) @@ -6360,7 +6361,7 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector) } } - if (ref->u.ar.type == AR_FULL) + if (!ref || ref->u.ar.type == AR_FULL) selector->rank = CLASS_DATA (selector)->as->rank; else if (ref->u.ar.type == AR_SECTION) selector->rank = ref->u.ar.dimen; @@ -6372,12 +6373,15 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector) if (rank) { - for (int i = 0; i < ref->u.ar.dimen + ref->u.ar.codimen; i++) - if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT - || (ref->u.ar.dimen_type[i] == DIMEN_UNKNOWN - && ref->u.ar.end[i] == NULL - && ref->u.ar.stride[i] == NULL)) - rank--; + if (ref) + { + for (int i = 0; i < ref->u.ar.dimen + ref->u.ar.codimen; i++) + if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT + || (ref->u.ar.dimen_type[i] == DIMEN_UNKNOWN + && ref->u.ar.end[i] == NULL + && ref->u.ar.stride[i] == NULL)) + rank--; + } if (rank) { diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 861f69ac20f..9f4dc072645 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -4138,6 +4138,16 @@ resolve_operator (gfc_expr *e) bool dual_locus_error; bool t = true; + /* Reduce stacked parentheses to single pair */ + while (e->expr_type == EXPR_OP + && e->value.op.op == INTRINSIC_PARENTHESES + && e->value.op.op1->expr_type == EXPR_OP + && e->value.op.op1->value.op.op == INTRINSIC_PARENTHESES) + { + gfc_expr *tmp = gfc_copy_expr (e->value.op.op1); + gfc_replace_expr (e, tmp); + } + /* Resolve all subnodes-- give them types. */ switch (e->value.op.op) @@ -9451,8 +9461,25 @@ fixup_array_ref (gfc_expr **expr1, gfc_expr *expr2, { gfc_ref *nref = (*expr1)->ref; gfc_symbol *sym1 = (*expr1)->symtree->n.sym; - gfc_symbol *sym2 = expr2 ? expr2->symtree->n.sym : NULL; + gfc_symbol *sym2; + gfc_expr *selector = gfc_copy_expr (expr2); + (*expr1)->rank = rank; + if (selector) + { + gfc_resolve_expr (selector); + if (selector->expr_type == EXPR_OP + && selector->value.op.op == INTRINSIC_PARENTHESES) + sym2 = selector->value.op.op1->symtree->n.sym; + else if (selector->expr_type == EXPR_VARIABLE + || selector->expr_type == EXPR_FUNCTION) + sym2 = selector->symtree->n.sym; + else + gcc_unreachable (); + } + else + sym2 = NULL; + if (sym1->ts.type == BT_CLASS) { if ((*expr1)->ts.type != BT_CLASS) diff --git a/gcc/testsuite/gfortran.dg/associate_55.f90 b/gcc/testsuite/gfortran.dg/associate_55.f90 index 2b9e8c727f9..245dbfc7218 100644 --- a/gcc/testsuite/gfortran.dg/associate_55.f90 +++ b/gcc/testsuite/gfortran.dg/associate_55.f90 @@ -26,7 +26,7 @@ contains class(test_t), intent(inout) :: obj integer, intent(in) :: a associate (state => obj%state(TEST_STATES)) ! { dg-error "no IMPLICIT type" } - state = a ! { dg-error "vector-indexed target" } + state = a ! { dg-error "cannot be used in a variable definition context" } ! state(TEST_STATE) = a end associate end subroutine test_alter_state2