From patchwork Mon Sep 19 20:17:46 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1306 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a5d:5044:0:0:0:0:0 with SMTP id h4csp1128818wrt; Mon, 19 Sep 2022 13:18:52 -0700 (PDT) X-Google-Smtp-Source: AMsMyM5AJ8JsLhclVaA9JWub/j+eAKzZf0lcYsdw6vSa/noRhLAczPH0dw50t3RcotHsln8lGBpP X-Received: by 2002:a17:907:75c2:b0:770:7bb7:9412 with SMTP id jl2-20020a17090775c200b007707bb79412mr14346194ejc.638.1663618731851; Mon, 19 Sep 2022 13:18:51 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1663618731; cv=none; d=google.com; s=arc-20160816; b=TzhukGwo/HoN9TJ2GdNSjt2ODTEx65RFsDeqi1xJO5UbnDf8yg80Ez9f0b3WWQmL0S JL4kOx8oft6V7aNxUM+LuEFlyA+ysHZICifcqDCOldp/bt36ArqCz5KfjVLbkCNWqbNQ fktARiRPh2c4SOGi62x0G5OPZaqIp+hlf+c91soToJU/Fw6MxnzdXXDy1+n+lotNHVws AvDoPomYMMm67SLeyJBxqlxOVn3p36gbrSLRmGgjnv1AMtpEXXoVCDelNAm8FHtnDKpD sQ/TqMC7F/fZdRg0SnBFh0yglgqolnhaFSY/fynow/k4mEMfbozrCDp6TnB85IVuYww5 CMMA== 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=GTATYc2aA7nUhIvFwVNHWtkoDHvo61VWmNZqvx6xZRU=; b=zb0VieQUAENl5F8p1lVD3wyhmv/8R3gNOg1vFumlb53pwKNBPpPJ+3CByw5SBynq0V 2CSKPGIv/hHeQqiIT+N0SfHdJwZtMCqXt1WRjM9uVakIca1OOous8Ko/bhBd7f4gtlfU ddABetIRrH+9aggMnAOXH5MnRxSMIniDWE1QiADNBOLMKhcDwy4dLmOFXhcPvG6zGY0r l5f0dhC/GeJLst9I3TWHYWhc2iDkOsDY4QOscztTUm2z1lmtYKidqHDrVYx3pceT0A5J t08u/aVngd8x61I4Wm964Ldz3lORajqMYsnw4op30IZ4e70R5od2XtZibOtOLu3QrcFW GlGA== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=dIeFz1xm; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c 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 (server2.sourceware.org. [2620:52:3:1:0:246e:9693:128c]) by mx.google.com with ESMTPS id hg6-20020a1709072cc600b007801b176810si13819401ejc.252.2022.09.19.13.18.51 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 19 Sep 2022 13:18:51 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) client-ip=2620:52:3:1:0:246e:9693:128c; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=dIeFz1xm; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c 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 5501B3858429 for ; Mon, 19 Sep 2022 20:18:50 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 5501B3858429 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1663618730; bh=GTATYc2aA7nUhIvFwVNHWtkoDHvo61VWmNZqvx6xZRU=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=dIeFz1xmRQjsU9tMslBqCchyv9xiuJEk4XvlVt0+xvZNqr7PjWkkfGGQgaE7IKdZ+ BBL9zB0oRGgcthanAjM9ffA8cRshkvWDpfvgfhq2V5xUNyp4kRNyYfmYarygHBFZfI IQiWnjRN+ElDzyuKQdrA9eDHNt9PgaglUtQur8Jc= 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 43C663858C56; Mon, 19 Sep 2022 20:17:48 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 43C663858C56 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [93.207.89.44] ([93.207.89.44]) by web-mail.gmx.net (3c-app-gmx-bs15.server.lan [172.19.170.67]) (via HTTP); Mon, 19 Sep 2022 22:17:46 +0200 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: Proxy ping [PATCH] Fortran: Fix function attributes [PR100132] Date: Mon, 19 Sep 2022 22:17:46 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:yvE5stulGJgQ3+Ex7JchGHnYRNrOdi8dSkD7cton8NCksb6xr0xgE1a/2kFfGQsMqVOCX uCQKIpg7p90xJpfjFuwNsSJHvaPefbLFGiR3EI9nEqSJjt7eukUB1EJVYLQSm2UODIlnueuCacUW mtZWFwtGtn1shLghYDdmFmDEjWu/VWP8Y+ZOXLl2xj1dSxB8AtDGI9fcGT80LUUhdzjJdJAj3cjF ckFTdWhD+0WN31EtrZststZOMNjytoNcBo9mN9V87JqeB0hf2y6/MOV6lQw+7xPsAzkPl6kp45EQ Tg= X-UI-Out-Filterresults: notjunk:1;V03:K0:UVVNL3xoXEA=:gjWWcUo4DA/I/omeN0Zf7u r9CAl4F2hDHq/cyGik+et8FEM9Z8wuoAmf9HXIxb5HeKQG4M/42xfm9aeykL6DUGzllztjbow uprDwa9WcZNv7rOAvQuq0zUwZJaxdJ4vgJ40OE36/mmw2AN51Wpo3YnoPiDuuY0/GX/bBF5Nt HsF/wLzkrFY0hmZQ5eaoKGIOohJe5W44hAjnBOGmuJ2T3uuZpbWNJOeNgVC+dCIN8MKJw9PMb utS+JNxGVJ+fMT3G8OvKyAq5MFjBP1QQHDKg+cGWGREr4gKcHREaeuyxYBhNuHGcijYgM2JMe +Cuk5K2N6pv/EUS8fUIa0toA1UjE/rKHbTdRJp8X/LkKSaUcAdlJqbzCHC6i14kbSKiTiCi15 RVhm02wPHaiBap/kIrt6GARZclG2maXtknqLPRFqkNag7GnRwu/rpqn9YWfh/bKQ9GlSZJ9Q0 fTgNfnBJ9YlO4p9skbcZ/r/NMbBV/BRGWuVXNg+yw5UAdugpKY7qYxgo0zN916sKD05U+vxGx E6BGPtVonLNDxgTIrHRUpgYDyvukhFbroEwP4M0w/kFYP8o7od8GXJ6pqUS73biZ7ugiqJ/oB G9CZQYxaT0uTTMky+PL8bX9dQ3Pgx3vxU6pjmSF5m33M0pCdV/dRgr5e9mAU0xr8lVe7W5BMn DAuIBqsfsQ1p5csz9D+7J8T5faOMuFpjugs0YAOfjJ5nOLIWXoZd9zEMG/3a30//IXxrEnqOw pKSTkKDXUBwZYmmoMe8t5oihN/WQrIhyDBseW5rKGLIsON76ua4Lf930s+k= X-Spam-Status: No, score=-11.7 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, KAM_SHORT, 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+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: =?utf-8?q?INBOX?= X-GMAIL-THRID: =?utf-8?q?1744430675212429717?= X-GMAIL-MSGID: =?utf-8?q?1744430675212429717?= Dear all, the following patch was submitted by Jose but never reviewed: https://gcc.gnu.org/pipermail/fortran/2021-April/055946.html Before, we didn't set function attributes properly when passing polymorphic pointers, which could lead to mis-optimization. The patch is technically fine and regtests ok, although it can be shortened slightly, which makes it more readable, see attached. When testing the suggested testcase I found that it was accepted (and working fine) with NAG, but it was rejected by both Intel and Cray. This troubled me, but I think it is standard conforming (F2018:15.5.2.7), while the error messages issued by Intel PR100132.f90(61): error #8300: If a dummy argument is allocatable or a pointer, and the dummy or its associated actual argument is polymorphic, both dummy and actual must be polymorphic with the same declared type or both must be unlimited polymorphic. [S] call set(s) -------------^ and a similar one by Cray, suggest that they refer to F2018:15.5.2.5, which IMHO does not apply here. (The text in the error message seems very related to the reasoning in Note 1 of that subsection). I'd like to hear (read: read) a second opinion on that. Thanks, Harald From 0b19cfc098554572279c8d19997df4823b426191 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 19 Sep 2022 22:00:45 +0200 Subject: [PATCH] Fortran: Fix function attributes [PR100132] gcc/fortran/ChangeLog: PR fortran/100132 * trans-types.cc (create_fn_spec): Fix function attributes when passing polymorphic pointers. gcc/testsuite/ChangeLog: PR fortran/100132 * gfortran.dg/PR100132.f90: New test. --- gcc/fortran/trans-types.cc | 15 +++++- gcc/testsuite/gfortran.dg/PR100132.f90 | 75 ++++++++++++++++++++++++++ 2 files changed, 88 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/PR100132.f90 diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index 0ea7c74a6f1..c062a5b29d7 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -3054,12 +3054,23 @@ create_fn_spec (gfc_symbol *sym, tree fntype) for (f = gfc_sym_get_dummy_args (sym); f; f = f->next) if (spec_len < sizeof (spec)) { - if (!f->sym || f->sym->attr.pointer || f->sym->attr.target + bool is_class = false; + bool is_pointer = false; + + if (f->sym) + { + is_class = f->sym->ts.type == BT_CLASS && CLASS_DATA (f->sym) + && f->sym->attr.class_ok; + is_pointer = is_class ? CLASS_DATA (f->sym)->attr.class_pointer + : f->sym->attr.pointer; + } + + if (f->sym == NULL || is_pointer || f->sym->attr.target || f->sym->attr.external || f->sym->attr.cray_pointer || (f->sym->ts.type == BT_DERIVED && (f->sym->ts.u.derived->attr.proc_pointer_comp || f->sym->ts.u.derived->attr.pointer_comp)) - || (f->sym->ts.type == BT_CLASS + || (is_class && (CLASS_DATA (f->sym)->ts.u.derived->attr.proc_pointer_comp || CLASS_DATA (f->sym)->ts.u.derived->attr.pointer_comp)) || (f->sym->ts.type == BT_INTEGER && f->sym->ts.is_c_interop)) diff --git a/gcc/testsuite/gfortran.dg/PR100132.f90 b/gcc/testsuite/gfortran.dg/PR100132.f90 new file mode 100644 index 00000000000..78ae6702810 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100132.f90 @@ -0,0 +1,75 @@ +! { dg-do run } +! +! Test the fix for PR100132 +! + +module main_m + implicit none + + private + + public :: & + foo_t + + public :: & + set, & + get + + type :: foo_t + integer :: i + end type foo_t + + type(foo_t), save, pointer :: data => null() + +contains + + subroutine set(this) + class(foo_t), pointer, intent(in) :: this + + if(associated(data)) stop 1 + data => this + end subroutine set + + subroutine get(this) + type(foo_t), pointer, intent(out) :: this + + if(.not.associated(data)) stop 4 + this => data + nullify(data) + end subroutine get + +end module main_m + +program main_p + + use :: main_m, only: & + foo_t, set, get + + implicit none + + integer, parameter :: n = 1000 + + type(foo_t), pointer :: ps + type(foo_t), target :: s + integer :: i, j, yay, nay + + yay = 0 + nay = 0 + do i = 1, n + s%i = i + call set(s) + call get(ps) + if(.not.associated(ps)) stop 13 + j = ps%i + if(i/=j) stop 14 + if(i/=s%i) stop 15 + if(ps%i/=s%i) stop 16 + if(associated(ps, s))then + yay = yay + 1 + else + nay = nay + 1 + end if + end do + if((yay/=n).or.(nay/=0)) stop 17 + +end program main_p -- 2.35.3