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: 118693 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:a6b2:0:b0:3e4:2afc:c1 with SMTP id c18csp703138vqm; Tue, 11 Jul 2023 12:40:21 -0700 (PDT) X-Google-Smtp-Source: APBJJlFdPeJ22RSE+4LkPIWKaxhjVJUdWB6YYt5ghjuSO9LuWkyePsRcDexOs+bgz/XR4+DWDYlV X-Received: by 2002:aa7:d295:0:b0:51e:227c:9492 with SMTP id w21-20020aa7d295000000b0051e227c9492mr20584702edq.20.1689104421431; Tue, 11 Jul 2023 12:40:21 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1689104421; cv=none; d=google.com; s=arc-20160816; b=KF0nxHjDgYATKSPdtqbKkKoRJr+aTJgGBKC05nLC9wglWERY+S2FAgvRECl4/S+LB0 uw4Tl1Th0JKoKDTDPuWnHXJQkCzlLwrb0WhLneRpkv7eWa3Y4aBn+OtFlbVXXJo0IlSR b7BLEv25M/pqQfbEJuk0/+38k8l3E3SE8zmPvThuCTy24efpfr+50mSyG7IzbdxEGTp1 h7TwIJuhrIhY7lJ3Qqk46uFqlCaF7FsO7JnuiGLEKlz46khnSEqKUxN3F0P+WR8AfoIj GU47yTTxtf+cJVA+OPsv/bwLHoiARuPlfoB8zJ8Akx2wMKWTwtTKaEHo8uPgjphxWvAV Rjug== 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:ui-outboundreport :sensitivity:importance:date:subject:to:message-id:mime-version :dmarc-filter:delivered-to:dkim-signature:dkim-filter; bh=BZX6Yt9SVWY+dWG7F8FX9Sz0iKHHu/37cQPzYl/yDmw=; fh=QK0YdXSiSCa48e9o4Ff7k6xpBN/ax2bSUZqWzYlsl7Q=; b=NmBJKH1VvZ/vw33iit0CauQDcjvVzCPGPCmTUv/pH+wVy5q5yRM/0CKmRlmQSruQqA +Tz6yfbmIAFwNIiWl1G+z7QRn8f5noldhPT1LH8pH/DFmw9EP9mSB/BrhrcIE7A1j15w gN3ZGmgO1pEWsE2qo+ph5C9iB8ubDfNgRbaJrJKZhhgNDnq61nxVQ636qNiNmSaxY3xP zml/Q2PYU90pnvbya+SzgwsZMbz+Gpye8UrXWf5haDpVUyZdu5vQmwthNLJAzvBScncg fnnWopUNVWInnFc0cIC6SGtzEsZ/tdIiDtjL3aGyluvu2aQSveWZmXgmflU0vBEkJxdx T3wg== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=xiYvMQfC; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 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 (ip-8-43-85-97.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id b10-20020aa7cd0a000000b0051df52adbfasi3080009edw.154.2023.07.11.12.40.21 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 11 Jul 2023 12:40:21 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=xiYvMQfC; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 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 B82693857726 for ; Tue, 11 Jul 2023 19:40:16 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org B82693857726 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1689104416; 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=xiYvMQfCT/a3ULLF0dPE/VsNar2vWVLhLLZc2kKg0dAICaUwHWWC7sjffZmC5hlZU 8XZbz9XiE/MZL9/wdQZLa+diFNqQbjR+Gce4tvaBAXre7dOq+ew4r7ApaYc0qV9w7r yCQviRB1eSVNdsW/Ai186raiYemAPNh0l1qDlWzg= 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+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1771154358001988462 X-GMAIL-MSGID: 1771154358001988462 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