From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.15.18]) by sourceware.org (Postfix) with ESMTPS id 8DBD43858D1E; Tue, 11 Jul 2023 19:39:33 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 8DBD43858D1E 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.de; s=s31663417; t=1689104371; x=1689709171; i=anlauf@gmx.de; bh=Lj0gYitjpQ9lR/3XjUg0aGkUTgbH/pVWehNllidDcx8=; h=X-UI-Sender-Class:From:To:Subject:Date; b=GA/f1BzF62pIx5+DBQr/Fcw+m5sFcPWhCrHZzI+aAv7w5ZpN5LOuiLgDfKG1MH3WwlnqBBq hWihJOzO8JGi9wZrGV6DaoSNppYPsQgv8FTqsaGVE2v3o8k3ygrTQBPyq1urRj0fLFhT3csZQ BLbAupH4gXWsfxHuL8Uo6svFGQtDzO++CrqyfLMjI7/gdmCkMdkW+9jzonQzKxlrondNli2Xw QlACOV4GuQxGFOxlIrN1B19D7cOrLeZa5ZOsF4JqUc2tULfnJZTxzWb2l3kA9XfYXiZa0ypXx tW60yYm3P9teIv6R1NhcjBepXmiFSDleobE+VK6HlHcXxhomu4wg== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.232.149.3] ([79.232.149.3]) by web-mail.gmx.net (3c-app-gmx-bs33.server.lan [172.19.170.85]) (via HTTP); Tue, 11 Jul 2023 21:39:31 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: formal symbol attributes for intrinsic procedures [PR110288] Content-Type: multipart/mixed; boundary=sgnirk-cc8665aa-1360-4a22-8157-67a55528bd9f Date: Tue, 11 Jul 2023 21:39:31 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:K5NpWQLge58gieGku3kcMw8wFVS9Mcp7Wrok/2CpVIyF38kPZuJFeOD3bdOm4T2q4T/uN kyeHseZEb1ey7JgwUXtjlrBFK2f6A+ilIbIECF/8gATlMk3N6XP781j3uA1eWCUyyJmqv0ajfIX1 +XTwBKffOJ1fV3d9itr7wQbdOaUNNgCzz1g9EUnYz67rmaQ4O2Nt/32jkpZoQkJ8feqnNu/D9K+/ u3eh57RJ8y1xk2PY2AQFP0ZgE8NT/q9Ed1u8pTteOiigKR0K5Gk6xDWItw/gv/qKaAi7fLZw7lL1 3s= UI-OutboundReport: notjunk:1;M01:P0:il+0NBZZx3g=;yn7c3DRmhIwNxNK44YaVM8Hlzci i67Gr4+GdmHTUawlUcDZ7NHfeik+eAvnlzr2JLWhvCpUkXWwCqGbV8meobuWVfVo4tx3i64Ve VPMSlcm76EtYShSFx2EDpRF8enIfZTEi1KEbsprK3d4EdbuoBtVV1qFIgh8TgCabkS5Qqbl6h M+GhdICmpN3tfiK0FPeseK39B4Vx+z9/ILcyDK8kPR8sA5u9xWFhoYYFN3evO+wc64nWItK8I 3BKlCOMtsSmSVBl0ZVWxRli9tzo7pCiBulUFC1483v1h7wNsznSCTRuKa6KAho9rO59MiTcDJ OfBZCnCiTNjdOsb//FwMdLQlioXoNIiey/tipvJhJFZKMylJJUJ2korrHFVW3lGsT4xOJQhlQ IcteV87/KAoo6hMte/pqbFQSxXTo8mt9nMQbvWfFQMu6EJms57SuSJ20hUuGtNB0tqsZKM/TQ gD4l8+bvNibqXrprnnJijphQ7PiBHD49q2VIcaSlAanSaPj/u8dDcMJeeh+fqtV+4CbU/zD7b 3/oCbPOIdXi9qz26MUjqjc0iLGAd6v4eDL4GSOGsryn8BFRT60k6PukfJFd0c/jlHHM92mWXr 2D14xKdCp2MIrVF3S+n1P58DzB2auJ5UqhnqRJc9KS4ArnbGDoDLEdx3+vSUsmm4CZ6LzlVbE R/YapATuRh1ZP0iC070TnYjY/WPlWhKpcxwUp7imqdES9Viiw0qq4yKuLEIVr+UW/wqJ5kU4s fDg/2WfZu6C03iHJlQycF5BtKV/strzlYDEdWrsBosw/jRGjg906PShCiQShXBh2kfZ8obVaM 42R+XjqIT414wEbRdMqqYO/A== X-Spam-Status: No, score=-10.7 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,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 List-Id: --sgnirk-cc8665aa-1360-4a22-8157-67a55528bd9f Content-Type: text/plain; charset=UTF-8 Dear all, for intrinsic procedures we derive the typespec of the formal symbol attributes from the actual arguments. This can have an undesired effect for character actual arguments, as the argument passing conventions differ for deferred-length (length is passed by reference) and otherwise (length is passed by value). The testcase in the PR nicely demonstrates the issue for FINDLOC(array,value,...), when either array or value are deferred-length. We therefore need take care that we do not copy ts.deferred, but rather set it to false if the formal argument is neither allocatable or pointer. Regtested on x86_64-pc-linux-gnu. OK for mainline? This is actually a 11/12/13/14 regression (and I found a potential "culprit" in 11-development that touched the call chain in question), so the patch might finally need backporting as far as seems reasonable. Thanks, Harald --sgnirk-cc8665aa-1360-4a22-8157-67a55528bd9f Content-Type: text/x-patch Content-Disposition: attachment; filename=pr110288.diff Content-Transfer-Encoding: quoted-printable =46rom 3b2c523ae31b68fc3b8363b458a55eec53a44365 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Tue, 11 Jul 2023 21:21:25 +0200 Subject: [PATCH] Fortran: formal symbol attributes for intrinsic procedure= s [PR110288] gcc/fortran/ChangeLog: PR fortran/110288 * symbol.cc (gfc_copy_formal_args_intr): When deriving the formal argument attributes from the actual ones for intrinsic procedure calls, take special care of CHARACTER arguments that we do not wrongly treat them formally as deferred-length. gcc/testsuite/ChangeLog: PR fortran/110288 * gfortran.dg/findloc_10.f90: New test. =2D-- gcc/fortran/symbol.cc | 7 +++++++ gcc/testsuite/gfortran.dg/findloc_10.f90 | 13 +++++++++++++ 2 files changed, 20 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/findloc_10.f90 diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc index 37a9e8fa0ae..90023f0ad73 100644 =2D-- a/gcc/fortran/symbol.cc +++ b/gcc/fortran/symbol.cc @@ -4725,6 +4725,13 @@ gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_in= trinsic_sym *src, formal_arg->sym->attr.flavor =3D FL_VARIABLE; formal_arg->sym->attr.dummy =3D 1; + /* Do not treat an actual deferred-length character argument wrongl= y + as template for the formal argument. */ + if (formal_arg->sym->ts.type =3D=3D BT_CHARACTER + && !(formal_arg->sym->attr.allocatable + || formal_arg->sym->attr.pointer)) + formal_arg->sym->ts.deferred =3D false; + if (formal_arg->sym->ts.type =3D=3D BT_CHARACTER) formal_arg->sym->ts.u.cl =3D gfc_new_charlen (gfc_current_ns, NULL); diff --git a/gcc/testsuite/gfortran.dg/findloc_10.f90 b/gcc/testsuite/gfor= tran.dg/findloc_10.f90 new file mode 100644 index 00000000000..4d5ecd2306a =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/findloc_10.f90 @@ -0,0 +1,13 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! PR fortran/110288 - FINDLOC and deferred-length character arguments + +program test + character(len=3D:), allocatable :: array(:) + character(len=3D:), allocatable :: value + array =3D ["bb", "aa"] + value =3D "aa" + if (findloc (array, value, dim=3D1) /=3D 2) stop 1 +end program test + +! { dg-final { scan-tree-dump "_gfortran_findloc2_s1 \\(.*, \\.array, \\.= value\\)" "original" } } =2D- 2.35.3 --sgnirk-cc8665aa-1360-4a22-8157-67a55528bd9f--