From patchwork Wed Jul 27 19:45:46 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 261 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a05:6a10:b5d6:b0:2b9:3548:2db5 with SMTP id v22csp610942pxt; Wed, 27 Jul 2022 12:46:41 -0700 (PDT) X-Google-Smtp-Source: AGRyM1t2rkBeYzFEutkDMa6tKvv1OFwREuhAM1SSSLQV4gdblr1SxbVCBCuBV60YjLPsSOgDXpFB X-Received: by 2002:a05:6402:35c4:b0:43b:fee5:2653 with SMTP id z4-20020a05640235c400b0043bfee52653mr16903283edc.415.1658951200969; Wed, 27 Jul 2022 12:46:40 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1658951200; cv=none; d=google.com; s=arc-20160816; b=w4K23sRKmC85m4RnoO03qEH2JSZhWZUXhJ0qH+NLtDGoc/9o7dVnaC0ZcOr1w6DLCf 3/Cmfl+pl61DISLyaSG5J62NEGe6Vq0G0RUVJ5r9ByD0snlbc6IVah9ymcDCwB6ThrIP 9YsU/mWV9g9D0qaDMx4gvpS8SyS6cmRuWldrnIgT8wvvYAlffz+Cfywhk7TSmY1ibC9J oIyej2rfZN5BPvUgKx7ja2d3TLAgYBARtn2XwOtASlU3cJgejkGiQX5FViMmjGs+njHm Qzla7IkM8sDeJElyidCpaTShgeO68kNHcJFVg3IfoV8UG7zvSR/oitz6ci7i9q3VGBtK 7qZQ== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:cc:reply-to:from:list-subscribe:list-help :list-post:list-archive:list-unsubscribe:list-id:precedence :in-reply-to:references:newsgroups:to:content-language:subject :user-agent:mime-version:date:message-id:dmarc-filter:delivered-to :dkim-signature:dkim-filter; bh=lSBUktkbq2MUd4r7MkdYRJT18OEdq6qASXrjQA9FWOQ=; b=bpug3etSjH5UvNY+3Fn1R1jIvgNmz+EO/agO2tR0QKPfY28X08gC6vEGLlnJMj6OxT 0VfmM5M1PfMY6p1cUKOpRh9r0pb0BnOPNOjs1S0jlOXi3kkacSXpcQTYp8f4U/Gub95t 1fxTya0rOGfqPf24PMgRRRYlByMFo5K+7mYKyKCdy4yPO+rXFR03BY35Lo1WV9OZDcfa 3KXbcLU4cnVcGdKCe802cCTDv/jh0ZauEHqlIR8CMTsa6iAavmsR05juKHL5Cahkg6mn neYNO+e/6qK3fe4Sxc0NABtX2KDvYk+fK0ferSa/lAai1001eb3k+tZ/DKsiPYYjxfUj QSgA== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=QSXxbLSF; 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=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from sourceware.org (ip-8-43-85-97.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id w16-20020a056402269000b0043c3e09a9f6si7942342edd.482.2022.07.27.12.46.40 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 27 Jul 2022 12:46:40 -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=pass header.i=@gcc.gnu.org header.s=default header.b=QSXxbLSF; 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=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 7D4C9385AE42 for ; Wed, 27 Jul 2022 19:46:34 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 7D4C9385AE42 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1658951194; bh=lSBUktkbq2MUd4r7MkdYRJT18OEdq6qASXrjQA9FWOQ=; h=Date:Subject:To:References:In-Reply-To:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:List-Subscribe:From:Reply-To:Cc: From; b=QSXxbLSF6CJNIH3wi8sOPGUB9UkJM9cJVmEvbxb4bQBw4nSuB3zjOoPOqEJobC7ns piTpOLCgnP1SW+IzYkcqFZy7bwp2EBxS+ZCwtIEbkHS3C5kCJQrvTwz7+woyyJZjPb hWJ5P0l64DAVek5aQC4QwjtsSY+GW7W0JrvNXEqU= 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.22]) by sourceware.org (Postfix) with ESMTPS id 20872385802A; Wed, 27 Jul 2022 19:45:50 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 20872385802A X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [192.168.178.29] ([93.207.84.120]) by mail.gmx.net (mrgmx104 [212.227.17.168]) with ESMTPSA (Nemesis) id 1MGz1f-1oCgN50MSJ-00E6lz; Wed, 27 Jul 2022 21:45:48 +0200 Message-ID: Date: Wed, 27 Jul 2022 21:45:46 +0200 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:91.0) Gecko/20100101 Thunderbird/91.11.0 Subject: [PATCH, v2] Fortran: fix invalid rank error in ASSOCIATED when rank is remapped [PR77652] Content-Language: en-US To: Mikael Morin Newsgroups: gmane.comp.gcc.fortran,gmane.comp.gcc.patches References: <8e300265-e24c-59c2-19b0-3d74fc5ed425@orange.fr> <2c940b18-08f2-adeb-6ac3-22e89b72440d@orange.fr> In-Reply-To: <2c940b18-08f2-adeb-6ac3-22e89b72440d@orange.fr> X-Provags-ID: V03:K1:JEyMK7vQ2nq1LktyahmDTZid9rbDTVUvyyTUdGUNFQVdrXA/jmN 6wMGdsSv9zNnwjsDYiWdWRjj0DIu/GKCDylK0rvzgsI7PxQ0+T23GeFi5FEMRGto6LCReHZ uRTE/gE181NILHy6KQIpPuO88qkvQyBIf/EH6fmXfHQpxtl4K7Mca5cO3r737Kdv4NHpPoj AIOt49ZFwJiBDrmEh/eHQ== X-UI-Out-Filterresults: notjunk:1;V03:K0:A0yR0pAdkV0=:d+RTUPhGwW0G5znlExsaRo B4GoXbXHocH89aOyW+S1ds/hst/sk3VRfW1HmgsGV4z/Q8QAVzZwdYcEFLHCROdRR2iwcEgyG 4v61LS/iQVds03HoVXKLSzrIJMuNd0GgqVB2QFsB/yubXSw/eaPCdJ9eOM73mtdS70IwsA1+w D34hTmAEnVl6Oj3ZTihy5MFbgsQPkbPkO8RLPnFou6ZDestcbPGZjsvoFkCsfNx5gar89vbVn Dw8AGcg6PCUN1m/eHjnalJ36OQCWZmbi7GfqgovLTl2ifBGBXkbluB37Uu+rpFiTjqSnOrzJz VfCFNdTw2esG0hWOePEasjspUio0YDKPPut8w9ogoJRW3ougd9WWdjw5i1VQTxNZj3adu+Fvs yU1Vjd/X4G0/t6buDOKSsS32uK5E/UpuUDG6VamEeeCbWhop1gc424OU1rNz+RUtsrM+Zg55+ 5DW9wCrWYK7/n7hFWoTEf66MMlcrcScN7ZWbUja57oJAoIUEGmtoEnKGOPMtPoEDlLsgaT04T KK0rhdMI8FRfmYJKbw1TMbV/VNFlMK7WJeFlSbC+NE7Jlk3WSO84XIh6KIkYdEMYnCQ0Dg1zu xpNCdUUXylk0mbDwgvzzfoLhHB7i/62hc1qlE1miafegSe+za+aoPfMm9GQ3u5eIuaURykCdW xkcm9613gY/ySIIfC8x0w28DSxIc5TdKq2bDIi3tsTZNujafygLiebKgQskbohkt5qqxjPzy6 gDDoucQuuaOgSRMDqIesfPqdlF3ft7SZbpUPG8SJUsRO6mo3Uq5Xy1dpRw8LP5ahYaLWmPL0E EToNrOpzBilmVOBYhZkQGHtOmgLV8PSp/L2hTFypVqKkI6PkafSmJe72j5vTatWIfIIyYJdl4 N1EmIrM6hMLO0YgvWf03LWBwHpTYt5t0hqiV/zPJtrqu8prmCAcSQz+qQiY6QBELbUtGCHBN6 lMB0hkU33RnzYuV+QkGqgHbKPCmttWsc3OakScOIZcFDULc4GzP9Z4wrcYT6+rZy6VB6qhw4P ETGxQ5+6slycSTYu6IGciKxEPiTOBJeJMOE95g74N1X0f45fg7rkV6qFxvDHkvgg5NKxnh63v odIaS4M/QK2KLtgjmSvZTf9DvXorCYt/oc9tNFRRmpPX2Jo9mHsCL/xTA== X-Spam-Status: No, score=-12.2 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP 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.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 Cc: gcc-patches , fortran Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: =?utf-8?q?INBOX?= X-GMAIL-LABELS: =?utf-8?b?IlxcSW1wb3J0YW50Ig==?= X-GMAIL-THRID: =?utf-8?q?1738994492675386070?= X-GMAIL-MSGID: =?utf-8?q?1739536414404729288?= Hi Mikael, Am 26.07.22 um 21:25 schrieb Mikael Morin: > Le 25/07/2022 à 22:18, Harald Anlauf a écrit : >> I would normally trust NAG more than Intel and Cray. > … and yourself, it seems.  Too bad. > >> If somebody else convinces me to accept that NAG has it wrong this >> time, I would be happy to proceed. > It won’t convince you about NAG, but here are two reasons to proceed: >  - Consensus among the maintainers is sufficient; it’s the case here. >  - If uncertain, let’s be rather too permissive than too strict; it’s > fine as long as the runtime answer is right. ok, I have thought about your comments in the review process, and played with the Cray compiler. Attached is a refined version of the patch that now rejects in addition these cases for which there are no possible related pointer assignments with bounds remapping: ASSOCIATED (scalar, array) ! impossible, cannot remap bounds ASSOCIATED (array, scalar) ! a scalar is not simply contiguous (Cray would allow those two, but IMHO these should be disallowed). See attached for version 2 with updated testcase, regtested again. I think this is what we could both be happy with... ;-) Thanks, Harald From 5432880ff21de862c64d79626aa19c4eda928cd5 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Wed, 27 Jul 2022 21:34:22 +0200 Subject: [PATCH] Fortran: fix invalid rank error in ASSOCIATED when rank is remapped [PR77652] gcc/fortran/ChangeLog: PR fortran/77652 * check.cc (gfc_check_associated): Make the rank check of POINTER vs. TARGET match the allowed forms of pointer assignment for the selected Fortran standard. gcc/testsuite/ChangeLog: PR fortran/77652 * gfortran.dg/associated_target_9a.f90: New test. * gfortran.dg/associated_target_9b.f90: New test. --- gcc/fortran/check.cc | 23 ++++++++++++++-- .../gfortran.dg/associated_target_9a.f90 | 27 +++++++++++++++++++ .../gfortran.dg/associated_target_9b.f90 | 23 ++++++++++++++++ 3 files changed, 71 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/associated_target_9a.f90 create mode 100644 gcc/testsuite/gfortran.dg/associated_target_9b.f90 diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index 91d87a1b2c1..1da0b3cbe15 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -1502,8 +1502,27 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target) t = false; /* F2018 C838 explicitly allows an assumed-rank variable as the first argument of intrinsic inquiry functions. */ - if (pointer->rank != -1 && !rank_check (target, 0, pointer->rank)) - t = false; + if (pointer->rank != -1 && pointer->rank != target->rank) + { + if (pointer->rank == 0 || target->rank == 0) + { + /* There exists no valid pointer assignment using bounds + remapping for scalar => array or array => scalar. */ + if (!rank_check (target, 0, pointer->rank)) + t = false; + } + else if (target->rank != 1) + { + if (!gfc_notify_std (GFC_STD_F2008, "Rank remapping target is not " + "rank 1 at %L", &target->where)) + t = false; + } + else if ((gfc_option.allow_std & GFC_STD_F2003) == 0) + { + if (!rank_check (target, 0, pointer->rank)) + t = false; + } + } if (target->rank > 0 && target->ref) { for (i = 0; i < target->rank; i++) diff --git a/gcc/testsuite/gfortran.dg/associated_target_9a.f90 b/gcc/testsuite/gfortran.dg/associated_target_9a.f90 new file mode 100644 index 00000000000..708645d5bcb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associated_target_9a.f90 @@ -0,0 +1,27 @@ +! { dg-do run } +! { dg-options "-std=f2018" } +! PR fortran/77652 - Invalid rank error in ASSOCIATED when rank is remapped +! Contributed by Paul Thomas + +program p + real, dimension(100), target :: array + real, dimension(:,:), pointer :: matrix + real, dimension(20,5), target :: array2 + real, dimension(:), pointer :: matrix2 + matrix(1:20,1:5) => array + matrix2(1:100) => array2 + ! + ! F2018:16.9.16, ASSOCIATED (POINTER [, TARGET]) + ! Case(v): If TARGET is present and is an array target, the result is + ! true if and only if POINTER is associated with a target that has + ! the same shape as TARGET, ... + if (associated (matrix, array )) stop 1 + if (associated (matrix2,array2)) stop 2 + call check (matrix2, array2) +contains + subroutine check (ptr, tgt) + real, pointer :: ptr(..) + real, target :: tgt(:,:) + if (associated (ptr, tgt)) stop 3 + end subroutine check +end diff --git a/gcc/testsuite/gfortran.dg/associated_target_9b.f90 b/gcc/testsuite/gfortran.dg/associated_target_9b.f90 new file mode 100644 index 00000000000..1daa0a7dde1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associated_target_9b.f90 @@ -0,0 +1,23 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } +! PR fortran/77652 - Invalid rank error in ASSOCIATED when rank is remapped +! Contributed by Paul Thomas + +subroutine s + real, dimension(100), target :: array + real, dimension(:,:), pointer :: matrix + real, dimension(20,5), target :: array2 + real, dimension(:), pointer :: matrix2 + real, pointer :: scalar, scalar2 + scalar => scalar2 + print *, associated (scalar, scalar2) + + matrix(1:20,1:5) => array ! F2003+ +! matrix2(1:100) => array2 ! F2008+ + print *, associated (matrix, array ) ! Technically legal F2003 + print *, associated (matrix2,array2) ! { dg-error "is not rank 1" } + + ! There exists no related valid pointer assignment for these cases: + print *, associated (scalar,matrix2) ! { dg-error "must be of rank 0" } + print *, associated (matrix2,scalar) ! { dg-error "must be of rank 1" } +end -- 2.35.3