From patchwork Mon Dec 4 21:52:16 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1871726 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=gmx.de header.i=anlauf@gmx.de header.a=rsa-sha256 header.s=s31663417 header.b=AUx5i03r; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4SkcrZ0D30z1ySh for ; Tue, 5 Dec 2023 08:54:21 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 3A569396E87A for ; Mon, 4 Dec 2023 21:53:03 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from eggs.gnu.org (eggs.gnu.org [IPv6:2001:470:142:3::10]) by sourceware.org (Postfix) with ESMTPS id 102A538708EF; Mon, 4 Dec 2023 21:52:38 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 102A538708EF Authentication-Results: sourceware.org; dmarc=fail (p=quarantine dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=fail smtp.mailfrom=gmx.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 102A538708EF Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2001:470:142:3::10 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1701726768; cv=none; b=Slunrga/FOznAsmbDwmQW87OehEiU2aXacuyeXQSAt/UbZfsWnZkmSR/eQgfdFjFZ6LiiLfLnA0zLm19upTa6p9QORdytogRw8miRPVfb0VAgnW/aSsZGc9HUgrX+p+YtosRELOc3Tph60aFxuMVt9S9+x0R5EEtnturCuzPG0c= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1701726768; c=relaxed/simple; bh=Lu+hkBTJ6SolrF92T43yt7PnZcmvnFGySNYDZbb18TI=; h=DKIM-Signature:MIME-Version:Message-ID:From:To:Subject:Date; b=MrTmdp1barIwCaUJnWNEOqdwnYaYs203IUg6TF9xbG8eROwnwyEVA+9GR1HCuocsUwkWulzQQIycdHjWYrZTyP7hjoVFKfITmiNbFziDrBNem7Om5lXs+ij1IUNIsFxT7dsQlCKfxTcD5vMdXsXTOqdNp81/tn0/wm8l/sIoXR4= ARC-Authentication-Results: i=1; server2.sourceware.org Received: from mout.gmx.net ([212.227.17.20]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rAGrh-0007vO-Tp; Mon, 04 Dec 2023 16:52:36 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1701726736; x=1702331536; i=anlauf@gmx.de; bh=Lu+hkBTJ6SolrF92T43yt7PnZcmvnFGySNYDZbb18TI=; h=X-UI-Sender-Class:From:To:Cc:Subject:Date; b=AUx5i03rYxncPETn2bZSlpy+5EynGkkMKwdiAr9+6VRDzH5ZQQV1o7nvJwD8JLtC Tdgw9bPFiAtf8RXm7BUKcGnCtIyUrreUovg6R5dzkDA7SeTw9UABMRF4hthRxEJlp ayiLEZuVJqXWqlP3CoPxGHcbBvlY4yOLzhTt9nmQjVsteOzLCrlrHF4t836S08OTs CsSqEE0Kx/9q2GSUlfNS6iPAQ9Ff8UJQy/aDRr9BiDz4HdAldMHb2GEU3WqgZG+n6 n1jefmfRYuaBvOO4nCsqAJnla+UNtS1rZUqkRG8wYkbGYmyJEzaHpuSImnpreH72D 5aXOAaT897sxaSKK6w== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.251.14.172] ([79.251.14.172]) by web-mail.gmx.net (3c-app-gmx-bap27.server.lan [172.19.172.97]) (via HTTP); Mon, 4 Dec 2023 22:52:16 +0100 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Cc: tobias@codesourcery.com Subject: [PATCH] Fortran: allow RESTRICT qualifier also for optional arguments [PR100988] Date: Mon, 4 Dec 2023 22:52:16 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:WlWAS1QVwGlhxzaHJWyK3GW/jks/0ICe3ZcIVxQH0mxEh8aWc6f/XjnGhsU4D1Vx1AI0t MN8/bqAI2Gh4+dXbdxqw2ZKPqbzD7MH097MHtjb+xSr/r9t/5hnlGiDXsxZYWaC6Uxs+1CqN54z2 rndA+wwSQbQIazSaklwMOUPKeN6mmRFlraiN+eQS9TvaDgg4kZqdKkni+8vXTB7T94pzKqvDxcXn ByEPy8faHIL4XcYNwYKb+VcTIDngrJOJj3kv+NzdXLW+zmeKpN0D8bNX0t8ezARQ7wWvJKnq0rYc gE= UI-OutboundReport: notjunk:1;M01:P0:lyZD+mNjiVY=;9VMumWDXRCq5bxIVHWcinopR8J2 Drq/1Dw2UjYj7JBXwrNyY7rMRMSXHJLTBO7D9V0v/qCycw9y7hp3XWXeCoXHruXKi8IylgCU6 tl9vq84DyuD/gY+5pt2IHNPIA0Cuuj9DYl4vhI9C845Fw7/DySnnYD3fih5ehg4xSyJsZnsvD jlh6eB/DX6eDLwL5ytHa5Ebg+BDeWzZj79DKs6Y2HIVrBGEj1ap/L8VIklUXEnBSuqV86FVER fwKNACJ5BPWuBDbufhPGth+7k/CB5uuRLqaDNtzMQwrXSbn/2clF0uBq3ZifDYpxoUN+LMcSZ P31ubRqssriJIdenYun6TIDk+vY9S8PxfWgMEq0FNDB/Imn9topuh5P12mCqwz6YNePK9KEyA TjCqH8AjSVfN2Ozvpmtak+d905+HscrNeEANSgAjLbeGhwtEzo9rX5Sqgfy17DgVnRcGCLNHC N/UTMtrVJMRq+JlhKZwiFa4lV4lJfDmxKSSEQx+r8yMl5mIwwkGp/chO5wzXIPUWnA28wPRcP 4CJe+ob9exzPwu08UEUxM7ZBYVBswDj//0tigcwFglYie9LsfTNE3AVtRPLiCzFdJ59B6Z8ke F7dmh8DuzBADIWJVCh3Ji81kgJ2ux+8BPi/6g3BvNTjsHmmbRDyY0UHciq1dKE5fWmxZA/XOU fwjQSO8pGISmoSHY2zS1pLFvn+5Bw7deD+bHDIvwTCc945b2uDDwf4espcHcg4Rr/sj2Dq4Yb 1cTWBUTHceasRyRTwryUH/lnpOwBXaFHlff8fcNR+5QvrYc89cfXZHmqM/Prx59GRx/y4OUdD cgULrGmZ+zRRCvTaz4oaxydRCMdLVfbDaAA1OV7/oOF1A= Received-SPF: pass client-ip=212.227.17.20; envelope-from=anlauf@gmx.de; helo=mout.gmx.net X-Spam_score_int: -27 X-Spam_score: -2.8 X-Spam_bar: -- X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H4=0.001, RCVD_IN_MSPIKE_WL=0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Status: No, score=-11.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, SPF_HELO_PASS, SPF_SOFTFAIL, TXREP, T_SCC_BODY_TEXT_LINE 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+incoming=patchwork.ozlabs.org@gcc.gnu.org Dear all, the attached patch picks up an observation by Tobias that we did not specify the RESTRICT qualifier for optional arguments even if that was allowed. In principle this might have prevented better optimization. While looking more closely, I found and fixed an issue with CLASS dummy arguments that mishandled this. This revealed a few cases in the testsuite that were matching the wrong patterns... Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald From aa25d35cb866f7f333b656938224866a70b93a69 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 4 Dec 2023 22:44:53 +0100 Subject: [PATCH] Fortran: allow RESTRICT qualifier also for optional arguments [PR100988] gcc/fortran/ChangeLog: PR fortran/100988 * gfortran.h (IS_PROC_POINTER): New macro. * trans-types.cc (gfc_sym_type): Use macro in determination if the restrict qualifier can be used for a dummy variable. Fix logic to allow the restrict qualifier also for optional arguments, and to not apply it to pointer or proc_pointer arguments. gcc/testsuite/ChangeLog: PR fortran/100988 * gfortran.dg/coarray_poly_6.f90: Adjust pattern. * gfortran.dg/coarray_poly_7.f90: Likewise. * gfortran.dg/coarray_poly_8.f90: Likewise. * gfortran.dg/missing_optional_dummy_6a.f90: Likewise. * gfortran.dg/pr100988.f90: New test. Co-authored-by: Tobias Burnus --- gcc/fortran/gfortran.h | 3 + gcc/fortran/trans-types.cc | 13 ++-- gcc/testsuite/gfortran.dg/coarray_poly_6.f90 | 2 +- gcc/testsuite/gfortran.dg/coarray_poly_7.f90 | 2 +- gcc/testsuite/gfortran.dg/coarray_poly_8.f90 | 2 +- .../gfortran.dg/missing_optional_dummy_6a.f90 | 2 +- gcc/testsuite/gfortran.dg/pr100988.f90 | 61 +++++++++++++++++++ 7 files changed, 74 insertions(+), 11 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr100988.f90 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index aa3f6cb70b4..a77441f38e7 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -4008,6 +4008,9 @@ bool gfc_may_be_finalized (gfc_typespec); #define IS_POINTER(sym) \ (sym->ts.type == BT_CLASS && sym->attr.class_ok && CLASS_DATA (sym) \ ? CLASS_DATA (sym)->attr.class_pointer : sym->attr.pointer) +#define IS_PROC_POINTER(sym) \ + (sym->ts.type == BT_CLASS && sym->attr.class_ok && CLASS_DATA (sym) \ + ? CLASS_DATA (sym)->attr.proc_pointer : sym->attr.proc_pointer) /* frontend-passes.cc */ diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index 084b8c3ae2c..5b11ffc3cc9 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -2327,8 +2327,8 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c) else byref = 0; - restricted = !sym->attr.target && !sym->attr.pointer - && !sym->attr.proc_pointer && !sym->attr.cray_pointee; + restricted = (!sym->attr.target && !IS_POINTER (sym) + && !IS_PROC_POINTER (sym) && !sym->attr.cray_pointee); if (!restricted) type = gfc_nonrestricted_type (type); @@ -2384,11 +2384,10 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c) || (sym->ns->proc_name && sym->ns->proc_name->attr.entry_master)) type = build_pointer_type (type); else - { - type = build_reference_type (type); - if (restricted) - type = build_qualified_type (type, TYPE_QUAL_RESTRICT); - } + type = build_reference_type (type); + + if (restricted) + type = build_qualified_type (type, TYPE_QUAL_RESTRICT); } return (type); diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_6.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_6.f90 index 53b80e442d3..344e12b4eff 100644 --- a/gcc/testsuite/gfortran.dg/coarray_poly_6.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_poly_6.f90 @@ -16,6 +16,6 @@ contains end subroutine foo end ! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_0_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } } -! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_0_1t \\* x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_0_1t \\* restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 index 44f98e16e09..d8d83aea39b 100644 --- a/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 @@ -16,6 +16,6 @@ contains end subroutine foo end ! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } } -! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 index cac305f03ec..abdfc0ca5f8 100644 --- a/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 @@ -16,6 +16,6 @@ contains end subroutine foo end ! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } } -! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } } ! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/missing_optional_dummy_6a.f90 b/gcc/testsuite/gfortran.dg/missing_optional_dummy_6a.f90 index c08c97a2c7e..c6a79059a91 100644 --- a/gcc/testsuite/gfortran.dg/missing_optional_dummy_6a.f90 +++ b/gcc/testsuite/gfortran.dg/missing_optional_dummy_6a.f90 @@ -47,7 +47,7 @@ contains end program test -! { dg-final { scan-tree-dump-times "scalar2 \\(slr1" 1 "original" } } +! { dg-final { scan-tree-dump-times "scalar2 \\(.* slr1" 1 "original" } } ! { dg-final { scan-tree-dump-times "= es1 != 0B" 1 "original" } } ! { dg-final { scan-tree-dump-times "assumed_shape2 \\(es1" 0 "original" } } diff --git a/gcc/testsuite/gfortran.dg/pr100988.f90 b/gcc/testsuite/gfortran.dg/pr100988.f90 new file mode 100644 index 00000000000..b7e1ae4a2e4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr100988.f90 @@ -0,0 +1,61 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! PR fortran/100988 - RESTRICT was missing for optional arguments + + ! There should be restrict qualifiers for a AND b: (4 cases) + subroutine plain (a, b) + integer :: a, b + optional :: b + end subroutine + + subroutine alloc (a, b) + integer :: a, b + allocatable :: a, b + optional :: b + end subroutine + + subroutine upoly (a, b) + class(*) :: a, b + optional :: b + end subroutine + + subroutine upoly_a (a, b) + class(*) :: a, b + allocatable :: a, b + optional :: b + end subroutine + +! { dg-final { scan-tree-dump "plain .* restrict a, .* restrict b\\)" "original" } } +! { dg-final { scan-tree-dump "alloc .* restrict a, .* restrict b\\)" "original" } } +! { dg-final { scan-tree-dump "upoly .* restrict a, .* restrict b\\)" "original" } } +! { dg-final { scan-tree-dump "upoly_a .* restrict a, .* restrict b\\)" "original" } } + + ! There should be no restrict qualifiers for the below 4 cases: + subroutine ptr (a, b) + integer :: a, b + pointer :: a, b + optional :: b + end subroutine + + subroutine tgt (a, b) + integer :: a, b + target :: a, b + optional :: b + end subroutine + + subroutine upoly_p (a, b) + class(*) :: a, b + pointer :: a, b + optional :: b + end subroutine + + subroutine upoly_t (a, b) + class(*) :: a, b + target :: a, b + optional :: b + end subroutine + +! { dg-final { scan-tree-dump-not "ptr .* restrict " "original" } } +! { dg-final { scan-tree-dump-not "tgt .* restrict " "original" } } +! { dg-final { scan-tree-dump-not "upoly_p .* restrict " "original" } } +! { dg-final { scan-tree-dump-not "upoly_t .* restrict " "original" } } -- 2.35.3