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: 56377 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 7F0F8385AE61 for ; Wed, 27 Jul 2022 19:46:20 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 7F0F8385AE61 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1658951180; 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=bKxWqh4VQSnIMEYYiJUOomebX4xMBvIpQNi+Fps0OqHGBd5U9n5GoR6X6fM4044iY jdkLtmEDdOgNRn5h2ylPHidNgexS67LdWohPODEHDvONZ0zs4cHzePrOGmqZNjQ2XL LtfTapp63fung7p+lqiq6+HDcQH7SARTgeJWjRsg= 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+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" 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