From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: 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 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.net; s=badeba3b8450; t=1663618666; bh=XxMQhmKdi/eNZIeiWm/YfrlWlgf4vsnWV3jbzlpzbo4=; h=X-UI-Sender-Class:From:To:Subject:Date; b=PH0stgra3UbRLY4NbN2PRj1xWwQwMbwuuzx+/jEia0fvckMRfQbdArQgeSFo0QC9S o/ko3IlLEz6sBKUugHbsHeN/tgkJENUQnq1xudxkbQU6wheGLx4YUaucxop8v1Bh7o q8ontZzrAnenBzuhdID3Ubn480W3qaPDf+WXqyQ0= 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: From: Harald Anlauf To: fortran , gcc-patches Subject: Proxy ping [PATCH] Fortran: Fix function attributes [PR100132] Content-Type: multipart/mixed; boundary=nika-8ff1ddc3-8f8f-498d-a4f1-a4ba10562c9c 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 List-Id: --nika-8ff1ddc3-8f8f-498d-a4f1-a4ba10562c9c Content-Type: text/plain; charset=UTF-8 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 --nika-8ff1ddc3-8f8f-498d-a4f1-a4ba10562c9c Content-Type: text/x-patch Content-Disposition: attachment; filename=pr100132.diff Content-Transfer-Encoding: quoted-printable =46rom 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. =2D-- 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 =2D-- 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 =3D gfc_sym_get_dummy_args (sym); f; f =3D f->next) if (spec_len < sizeof (spec)) { - if (!f->sym || f->sym->attr.pointer || f->sym->attr.target + bool is_class =3D false; + bool is_pointer =3D false; + + if (f->sym) + { + is_class =3D f->sym->ts.type =3D=3D BT_CLASS && CLASS_DATA (f->sym) + && f->sym->attr.class_ok; + is_pointer =3D is_class ? CLASS_DATA (f->sym)->attr.class_pointer + : f->sym->attr.pointer; + } + + if (f->sym =3D=3D NULL || is_pointer || f->sym->attr.target || f->sym->attr.external || f->sym->attr.cray_pointer || (f->sym->ts.type =3D=3D BT_DERIVED && (f->sym->ts.u.derived->attr.proc_pointer_comp || f->sym->ts.u.derived->attr.pointer_comp)) - || (f->sym->ts.type =3D=3D 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 =3D=3D BT_INTEGER && f->sym->ts.is_c_interop)) diff --git a/gcc/testsuite/gfortran.dg/PR100132.f90 b/gcc/testsuite/gfortr= an.dg/PR100132.f90 new file mode 100644 index 00000000000..78ae6702810 =2D-- /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 =3D> null() + +contains + + subroutine set(this) + class(foo_t), pointer, intent(in) :: this + + if(associated(data)) stop 1 + data =3D> this + end subroutine set + + subroutine get(this) + type(foo_t), pointer, intent(out) :: this + + if(.not.associated(data)) stop 4 + this =3D> 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 =3D 1000 + + type(foo_t), pointer :: ps + type(foo_t), target :: s + integer :: i, j, yay, nay + + yay =3D 0 + nay =3D 0 + do i =3D 1, n + s%i =3D i + call set(s) + call get(ps) + if(.not.associated(ps)) stop 13 + j =3D ps%i + if(i/=3Dj) stop 14 + if(i/=3Ds%i) stop 15 + if(ps%i/=3Ds%i) stop 16 + if(associated(ps, s))then + yay =3D yay + 1 + else + nay =3D nay + 1 + end if + end do + if((yay/=3Dn).or.(nay/=3D0)) stop 17 + +end program main_p =2D- 2.35.3 --nika-8ff1ddc3-8f8f-498d-a4f1-a4ba10562c9c--