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: "Li, Pan2 via Gcc-patches" X-Patchwork-Id: 109 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:adf:e252:0:0:0:0:0 with SMTP id bl18csp1623397wrb; Thu, 21 Jul 2022 13:13:04 -0700 (PDT) X-Google-Smtp-Source: AGRyM1vA8GWMCc/srC+wFt4lP7o9obvl6YuYQ9AGifmV/lnqnQiq31iz+8hmkyFwM4+ITYdG4ks8 X-Received: by 2002:a05:6402:4016:b0:43a:f310:9522 with SMTP id d22-20020a056402401600b0043af3109522mr43211eda.200.1658434384368; Thu, 21 Jul 2022 13:13:04 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1658434384; cv=none; d=google.com; s=arc-20160816; b=ySKoLg3N4FCyOUb2sp0xzhAeCveSq/2wA9keLwUYvt33/vS6Fck+lCOQ5p+rRMUz4s /YhgN8CRAzH4Y3ZiBDf1eBLgKGsLd/bdgYNyfqGT4rxEUxijzoePjabiVpuVL3rxmvdX gclsENeQkrDB04pZ48bbB9tLKhc6lZmWEwxndpn84MmpT04kaTGAQmrtVrjqgiTQz/m0 iGkj8rwD9KLsnNXTQHOluf6/GURO46/jOeE8SOh+OloDq21WlY16yqJq3gyfJ4aSfAaO FcZHQHQTvHHGC0i63z/0HSYDP3GbtXDkf3UmpN5nwMU0CVlop6SZ9OEVfwF7hM2Z+o1E sLdA== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence:sensitivity :importance:date:subject:to:message-id:mime-version:dmarc-filter :delivered-to:dkim-signature:dkim-filter; bh=PKsptKfrhnQO1zOqbkbn9CU+Np+jCyy//jM7DewWkiM=; b=PId82RWSy1wNLDfrUFq2AVPQuG9c5fzyMhh4s1zlA47zCHiCGH0ZgUkyHWVHsEHcGB 3mtGiDYuniTl7rw7rCYChLjneepEn8HSKfcFuxoAJrKTeaV/EbX6VzS+Mbiij2dNL4ip wQm44aMRnttBgSL8CMEx9FjfUuW8d6HUJWjiUNVwv2rdzxUMPoeJaxTZ6tNG4j4ILjTh h1aUZAmX6FZOkojpZ015rtXNOOCU7B/2yq3si66e1zRXt4ghbOiRplZexD1Ay2YAc7Mr kKwPwUuxzOmcOG2S1XY/wy1UMBC08f/NbHurJrVg1dSwiZhzrw4Pq9Tvvfff4PtNeUvK nhlg== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=GuRgUoYz; 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 sc40-20020a1709078a2800b00726c07b617fsi1058313ejc.512.2022.07.21.13.13.04 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 21 Jul 2022 13:13:04 -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=GuRgUoYz; 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 0620F3838F35 for ; Thu, 21 Jul 2022 20:13:00 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 0620F3838F35 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1658434380; 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=GuRgUoYzHlL1FZ1EpF1+IzTGrTk8J60xPpvKd80a7pEFPEl4NDs5KIJJNqOdlJZWy k3O9Ga8XRQtO36+uZyI6wBjjvk0ig8oUsYvz3h+Ae4PlRum4uOq63RToGAKn3FJYyl 8GjCk3x7l02O3IrgIOPBR7N0eI2S4NyiwDuJtuyA= 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: "Li, Pan2 via Gcc-patches" Reply-To: Harald Anlauf 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-THRID: =?utf-8?q?1738994492675386070?= X-GMAIL-MSGID: =?utf-8?q?1738994492675386070?= 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