From patchwork Tue Mar 12 22:12:22 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1911380 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=nXy5PnbK; 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 4TvSZh47qyz1yWt for ; Wed, 13 Mar 2024 09:13:15 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id F25093858022 for ; Tue, 12 Mar 2024 22:13:12 +0000 (GMT) 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.21]) by sourceware.org (Postfix) with ESMTPS id 1A2533858D3C; Tue, 12 Mar 2024 22:12:24 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 1A2533858D3C Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 1A2533858D3C Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.17.21 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1710281546; cv=none; b=rnnpioGn2hXhUhWBKkIFNR2cf63Sx/ZFAe110Wg1rbNpraOtGLPKF9bo11gHNqVlJ7co0TrO6AXg3KHuXPxHcrE2wsyOiUmhHOa03w5ePAiOJTBqJ34vcjdctjyfsQniMY2GtVMxqSErTSxr6u9FgkhyJKshsV5N8/1XtqA3oJs= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1710281546; c=relaxed/simple; bh=KZansU7yhvY0s/iINvC4sDk+u9b+blM0xdeF+2BMuiE=; h=DKIM-Signature:MIME-Version:Message-ID:From:To:Subject:Date; b=UjsD0zSmfrO84q0HDn9nC/4GPH7JfTnd74v4DDzdncdyNtmxRwX1m063oEgJ1zeHAPYBIkJVIsJRqLqQ7/O41UAuBeMofHJUtaHOFeHgxy3MCMBbQq26XsPhxn5kMtutryLhP+36TaTagKTmbVeyqFgaVfTu2dO80I8GruWey7o= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1710281542; x=1710886342; i=anlauf@gmx.de; bh=KZansU7yhvY0s/iINvC4sDk+u9b+blM0xdeF+2BMuiE=; h=X-UI-Sender-Class:From:To:Subject:Date; b=nXy5PnbKRP4R6997n0fZ9GBfkNo8rDkHGQKWQ13131etDADmDX/Qd0URh9+/OWd+ j79tthfCQVN0Gp/P+V8MVnTKoh/b3vD4sUKYpmmp2cHrzMp8CV6mr1rz66Kw+EecI SkDf5v/okEGYptur3OrIMZds8omE+kk5MywZ+kzw0gFhX6CL7GGrhmIk2pFt9TWO9 Rme5bpGdwJh+Z0Km63UTojCdRXhDVkZjUBGUyu1Yq8vkLhv3DUQtDybA8dfe4mfk2 t5DZ3sNyn1VOZ2TEwv6zDqVGUYtSOXLluOonA6nplgZD5hYKL3v74N5VL7fRR6XI7 3EukvrWRyR1B37bJBQ== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.232.146.234] ([79.232.146.234]) by web-mail.gmx.net (3c-app-gmx-bap41.server.lan [172.19.172.111]) (via HTTP); Tue, 12 Mar 2024 23:12:22 +0100 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: fix IS_CONTIGUOUS for polymorphic dummy arguments [PR114001] Date: Tue, 12 Mar 2024 23:12:22 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:9zR0b8RYP9RW2UwfkrCM7u4zBp7bpGhz79BBV+8ncOM15LCwok7d9cNg3dip1qvQhScmB x78sAC2nptprU13Z/eWym6gZTR/2YFXFAUyoxgkR7KZ38eenoxCbGFlvxfluAwyEIgLjdChXm+Wg xA+Cuo1n8MRqEcmPwovieaVBPWncLK+/cxR2jcH0QprjC8rbAJ706rjyTPbnZ6N6Aw3BOXm9h3cN mbc7bjVQe1kOHPH+2fWaOM7xtDR3HkUXz7kqctflSIbe6QtZZ6gi4Z7KJ+4igZfithHERFArJImy Ro= UI-OutboundReport: notjunk:1;M01:P0:YG/j84+La3k=;KQE97KmFtx8PsvmCJTIFnNFKHDn I+zRUR/z3ThQo77XGA7qVvZYkY8Mof3BUKojAIbrixqZVSa//nXGyy5LkcgdqqfFh29RL9jR6 qI+zDnyvy0zWW7kLkCsx/8MdY8BRw9jfV6PKa/cVieKptOLN29RAWGcKmyGuuV2Ib5e0PbInI QNTcJu298+BiyUrRTZvAmW1yymuHraufXoJ9QRCop3+4EqesW0ZGHAZPDjrB1l91PPFoVJwb1 mB7edS2yFC4WGxBdrDuddlI2NPCsh0xACCb+Oa2Vr/wgGahcQkg8tSrZEua4S0N3puoAa4Rbo okiu9ZwlDW2pnqwVVR9406O485otQxdmtR2in/wxljGfkY6ZqsB7mN1yO2tH3UXiLtUuebMfa NNTCMNGesNQIkuXkmoT/ez2AQgfZTTotG3N5GsyU4qZ+kWBfQJftnXU7xMUUj0u4GWF+iYbUU zMmZDVSqblhQgD/Dq2FHtUE57Ib9c2Nwc6UDYx3PoMg0nXdEg8ydCUi7pwNQEtthzyAiTqz3Y bQiRjPKdw/D585uFHg4CbvBP34hsk7Q7rGLCcPaerBfMm3j1mM8t7rBAQf/bptQWAifxKUp19 eXFb9qASxPvn1SnOKxAiXYnLODzVNHyB1juwXtqnbv7TeWVcsFunxfsmgzIvQzbNLmNpt0BYj uXkHKDIfDhxiCGQOTB4qVxO2TyFzXSMPUwCEGe9Qc5Iw4QGNruvcosuwc1RYJ2I= X-Spam-Status: No, score=-9.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_BARRACUDACENTRAL, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, RCVD_IN_SORBS_WEB, SPF_HELO_NONE, SPF_PASS, 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, here's another small fix: IS_CONTIGUOUS did erroneously always return .true. for CLASS dummy arguments. The solution was to adjust the logic in gfc_is_simply_contiguous to also handle CLASS symbols. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald From 8f535b19bd0cb6a7c99ac9ba4c07778f86698a1c Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Tue, 12 Mar 2024 22:58:39 +0100 Subject: [PATCH] Fortran: fix IS_CONTIGUOUS for polymorphic dummy arguments [PR114001] gcc/fortran/ChangeLog: PR fortran/114001 * expr.cc (gfc_is_simply_contiguous): Adjust logic so that CLASS symbols are also handled. gcc/testsuite/ChangeLog: PR fortran/114001 * gfortran.dg/is_contiguous_4.f90: New test. --- gcc/fortran/expr.cc | 19 ++--- gcc/testsuite/gfortran.dg/is_contiguous_4.f90 | 81 +++++++++++++++++++ 2 files changed, 91 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/is_contiguous_4.f90 diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index 37ea95d0185..82a642b01f7 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -6025,15 +6025,16 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element) } sym = expr->symtree->n.sym; - if (expr->ts.type != BT_CLASS - && ((part_ref - && !part_ref->u.c.component->attr.contiguous - && part_ref->u.c.component->attr.pointer) - || (!part_ref - && !sym->attr.contiguous - && (sym->attr.pointer - || (sym->as && sym->as->type == AS_ASSUMED_RANK) - || (sym->as && sym->as->type == AS_ASSUMED_SHAPE))))) + if ((part_ref + && part_ref->u.c.component + && !part_ref->u.c.component->attr.contiguous + && IS_POINTER (part_ref->u.c.component)) + || (!part_ref + && expr->ts.type != BT_CLASS + && !sym->attr.contiguous + && (sym->attr.pointer + || (sym->as && sym->as->type == AS_ASSUMED_RANK) + || (sym->as && sym->as->type == AS_ASSUMED_SHAPE)))) return false; if (!ar || ar->type == AR_FULL) diff --git a/gcc/testsuite/gfortran.dg/is_contiguous_4.f90 b/gcc/testsuite/gfortran.dg/is_contiguous_4.f90 new file mode 100644 index 00000000000..cb066f8836b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/is_contiguous_4.f90 @@ -0,0 +1,81 @@ +! { dg-do run } +! PR fortran/114001 - IS_CONTIGUOUS and polymorphic dummy + +program main + implicit none + integer :: i, cnt = 0 + logical :: expect + integer, target :: m(10) = [(i,i=1,size(m))] + integer, pointer :: p(:) + type t + integer :: j + end type t + type(t), pointer :: tt(:), tp(:) ! Type pointer + class(t), pointer :: ct(:), cp(:) ! Class pointer + + p => m(1:3) + expect = is_contiguous (p) + print *, "is_contiguous (p)=", expect + if (.not. expect) stop 91 + call sub_star (p, expect) + p => m(1::3) + expect = is_contiguous (p) + print *, "is_contiguous (p)=", expect + if (expect) stop 92 + call sub_star (p, expect) + + allocate (tt(10)) + tt(:)% j = m + tp => tt(4:6) + expect = is_contiguous (tp) + if (.not. expect) stop 96 + print *, "is_contiguous (tp)=", expect + call sub_t (tp, expect) + tp => tt(4::3) + expect = is_contiguous (tp) + if (expect) stop 97 + print *, "is_contiguous (tp)=", expect + call sub_t (tp, expect) + + allocate (ct(10)) + ct(:)% j = m + cp => ct(7:9) + expect = is_contiguous (cp) + print *, "is_contiguous (cp)=", expect + if (.not. expect) stop 98 + call sub_t (cp, expect) + cp => ct(4::3) + expect = is_contiguous (cp) + print *, "is_contiguous (cp)=", expect + if (expect) stop 99 + call sub_t (cp, expect) + +contains + + subroutine sub_star (x, expect) + class(*), intent(in) :: x(:) + logical, intent(in) :: expect + cnt = cnt + 10 + if (is_contiguous (x) .neqv. expect) then + print *, "sub_star(1): is_contiguous (x)=", is_contiguous (x), expect + stop (cnt + 1) + end if + select type (x) + type is (integer) + if (is_contiguous (x) .neqv. expect) then + print *, "sub_star(2): is_contiguous (x)=", is_contiguous (x), expect + stop (cnt + 2) + end if + end select + end + + subroutine sub_t (x, expect) + class(t), intent(in) :: x(:) + logical, intent(in) :: expect + cnt = cnt + 10 + if (is_contiguous (x) .neqv. expect) then + print *, "sub_t: is_contiguous (x)=", is_contiguous (x), expect + stop (cnt + 3) + end if + end +end -- 2.35.3