From patchwork Thu Jul 21 20:12:15 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 56238 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 F108D3838AA6 for ; Thu, 21 Jul 2022 20:12:45 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org F108D3838AA6 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1658434366; bh=PKsptKfrhnQO1zOqbkbn9CU+Np+jCyy//jM7DewWkiM=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=FbHKCEJSQSbLfhDe5vWb8Hafkc/MUy1GZt6FSSqV0p0zXsgAxtKgD6c7xoVx6dHFU 1EEX5unoJe+7CCyfjtMcamuagjvL+N7P6PRsODvTxTmOVZBDdrvugH29ytmstuaw6b ip2Xuy3Fbc+6C17PqdLSoqFG8AhaArLoy2ZzYlis= 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 DCA47383A379; Thu, 21 Jul 2022 20:12:16 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org DCA47383A379 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [79.251.14.92] ([79.251.14.92]) by web-mail.gmx.net (3c-app-gmx-bs48.server.lan [172.19.170.101]) (via HTTP); Thu, 21 Jul 2022 22:12:15 +0200 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] Fortran: fix invalid rank error in ASSOCIATED when rank is remapped [PR77652] Date: Thu, 21 Jul 2022 22:12:15 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:vzImac8ON4+Ifx/Q/YgmwbHhjQspDXx5hkp4B7kCbk5hQENAakSXpJ1hXZmyzifzBQjPX 74+7HrUX6gxleeALLtzx9Q3sY1NOXB7E3nn7UoSLV3eT5c1wqCx3FErM36qhNnJ69MHgBHQYH5en wj0wZSkGnq1RKcM76O3B8tJai6B7IIMWUHcQBiYy1GG34QyBa5R/7bugAEvB7jL80koNLuuiMZ28 7K4A7PrO+Hcf+TRhNW4wdbxX4bgIlxtSjU2mm0v7PJceVM1kTMuu04jE1CVv5UPvS2NYV4i57GfA jo= X-UI-Out-Filterresults: notjunk:1;V03:K0:uQPAaA4ftL4=:rRfVgqDT2FTF9Fqr2L2ZHm wfBy+rxXhVOP/qQsXHHBoRoD65rDMjjBaeZizSLem8fmr2UYjwunNIQzMx20WnUyDnuY/oMkm PIEqwkvEPXSRlmc/xulPd7UlHIJc1wWX81nnX6HSTVIMSrNan64w49SiZFt9LRQZu6DssCJHH 3VrEWtNSIMB7XQeJGkCEAeQUpxKWMjt3JHM8UCoLf1cYT3vNu9V8J36luus0LLped1O2N328J 2Pr+yFXyavAhrXsE492bKDrvwkyR09wIR1egY1qTmXN5F4WHfGRHc41ucHbJNSZcWyfKMNUFD Wn6GhWJr/g6x0Y+lBmS533CYedBzucFqr96JoI+XDwErfuTplNKk3DZPJ5e3T7qESD7UP+7Uj 9fFVJINkWINxrnoQYM6AqgpOXDDaPkfiN7iN0rQ94QViSmUptm0rVWKTN7QoFi809KCy7PNV4 Ee1ns/BNIxJCvdxlK9kI7qEous2zKWTz8U98BYmR+Ywz1qu8pWZZmWh9rHoLyLrcF/Y2OE69r M+ffugqxiknOGn2OFYJIFGADgklAUW/D9+HBjzseWZZuRPfG9mnCM4NOJX7sMgiYfGBzGKqbz Dj6kWCjTGByBb1sFp06Od2NkThTJPlaUJK4oAYQL5oUrfiBND43pcUV7ypVzDaZ18u1XF6qMH dPCSXnieYw5E5Ko76NCJ6casrrRuPlN+KvATMNZThDzSy73uPTAskI/z1K6zQQORIYB/J5prA S5JOHOFIOS4RqYhluGS7KMNqE52wCn+aM4b9wnCR/LsyGFM3tPO8ZuFK1N5IVCJ0if7aLjxqy HWAi1le X-Spam-Status: No, score=-12.0 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 Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Dear all, the rank check for ASSOCIATED (POINTER, TARGET) did not allow all rank combinations that were allowed in pointer assignment for newer versions of the Fortran standard (F2008+). Fix the logic. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald From 338b43aefece04435d32f961c33d217aaa511095 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Thu, 21 Jul 2022 22:02:58 +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 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 | 16 +++++++++-- .../gfortran.dg/associated_target_9a.f90 | 27 +++++++++++++++++++ .../gfortran.dg/associated_target_9b.f90 | 15 +++++++++++ 3 files changed, 56 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..6d3a4701950 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -1502,8 +1502,20 @@ 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 (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..ca62ab155c0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associated_target_9b.f90 @@ -0,0 +1,15 @@ +! { 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 +! matrix(1:20,1:5) => array +! matrix2(1:100) => array2 + print *, associated (matrix, array ) ! Technically legal F2003 + print *, associated (matrix2,array2) ! { dg-error "is not rank 1" } +end -- 2.35.3