From patchwork Tue Jul 11 19:39:31 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1806499 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: legolas.ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha256 header.s=default header.b=a2Ra61Ch; dkim-atps=neutral Received: from server2.sourceware.org (ip-8-43-85-97.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (P-384) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4R0rms1YMSz20WT for ; Wed, 12 Jul 2023 05:39:55 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 60E293857023 for ; Tue, 11 Jul 2023 19:39:53 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 60E293857023 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1689104393; bh=BZX6Yt9SVWY+dWG7F8FX9Sz0iKHHu/37cQPzYl/yDmw=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=a2Ra61ChRB6y2pnngf+VsvvgAOdo3FUx4McGKO3R14tECZTGi3FWrtIQcDsMWpgYH UHEWbrgxpgVGZVmOrlcPD6CdViAX+8bkm2Qa0nHkzcwtpgSA2dwj/zVhbEI2ujlH8n Ss/OOGPCrtX7PRJmAWeZOnrx/PYWRiz5tGWkJcXA= 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.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 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: To: fortran , gcc-patches Subject: [PATCH] Fortran: formal symbol attributes for intrinsic procedures [PR110288] 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 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+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" 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 From 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 procedures [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. --- 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 --- a/gcc/fortran/symbol.cc +++ b/gcc/fortran/symbol.cc @@ -4725,6 +4725,13 @@ gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src, formal_arg->sym->attr.flavor = FL_VARIABLE; formal_arg->sym->attr.dummy = 1; + /* Do not treat an actual deferred-length character argument wrongly + as template for the formal argument. */ + if (formal_arg->sym->ts.type == BT_CHARACTER + && !(formal_arg->sym->attr.allocatable + || formal_arg->sym->attr.pointer)) + formal_arg->sym->ts.deferred = false; + if (formal_arg->sym->ts.type == BT_CHARACTER) formal_arg->sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); diff --git a/gcc/testsuite/gfortran.dg/findloc_10.f90 b/gcc/testsuite/gfortran.dg/findloc_10.f90 new file mode 100644 index 00000000000..4d5ecd2306a --- /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=:), allocatable :: array(:) + character(len=:), allocatable :: value + array = ["bb", "aa"] + value = "aa" + if (findloc (array, value, dim=1) /= 2) stop 1 +end program test + +! { dg-final { scan-tree-dump "_gfortran_findloc2_s1 \\(.*, \\.array, \\.value\\)" "original" } } -- 2.35.3