From patchwork Tue Apr 15 19:01:22 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 110515 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 14DAF3857BA2 for ; Tue, 15 Apr 2025 19:02:52 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 14DAF3857BA2 Authentication-Results: sourceware.org; dkim=pass (2048-bit key, secure) header.d=gmx.de header.i=anlauf@gmx.de header.a=rsa-sha256 header.s=s31663417 header.b=onBAyh43 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 45D3C3858D29; Tue, 15 Apr 2025 19:01:26 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 45D3C3858D29 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 45D3C3858D29 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.15.18 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1744743686; cv=none; b=SpSNGMYJTHVSd4DEk9SXs6HGZ4THebkyokPg1TzxRg1oQl55Hw+mgFgEaU7mtVrfcslEgsxdAJxbWJM7ijSzo4k0k9TOI+8PN3il7AF+LJF9RjUvZ6UaQOmP3TVt2IaxiFhdJZgUkOy8+uy4XvJanX2/HUpkQwIQw7XZjgaKPpc= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1744743686; c=relaxed/simple; bh=DJVnffrxTVq5/uzsbPXtm8OiC9bvYFSOHAKl3HiHKxU=; h=DKIM-Signature:Message-ID:Date:MIME-Version:To:From:Subject; b=CoiWe4eB+Lq4BUgkqQcJkkLhONnLDOXtBRj8pYglUIIs1wQC594VlYgddOq/eWFoclb14yjVtAFF/S/IzmJEuNT8g5kpxxiZAN7GmRjOR2x0lb7txS3DNRBn6ba2oifmxhtmM7W3k+8+K5IZLb7SErm6SORFTM2L9wj6hwYzaRc= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 45D3C3858D29 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmx.de; s=s31663417; t=1744743685; x=1745348485; i=anlauf@gmx.de; bh=N7xzX2p7+ynaL0CfS1rI5pHl0coZ4F0arhxy57YUrS4=; h=X-UI-Sender-Class:Content-Type:Message-ID:Date:MIME-Version:To: From:Subject:cc:content-transfer-encoding:content-type:date:from: message-id:mime-version:reply-to:subject:to; b=onBAyh43NN/PhBw4XUCsDpenrCbwL1Ku6FkauZ6xVVGAg7aBsl3i406ZKtUGNPKE TkDiCQa5+/jvQhXpM++V2EjpQfL6W4aCfKsnGPLR0xxWluOm/1qzGRQ+8+SCwNCrU mu9sTTAX/zPttRQXA4uNGnKK71UIDqv35cmsafal5Ptrza6O00y+H57hXfP4Ilbey GQCgw3NoY5br+pbybvoYFHZYMtQZ1uvCCBH4Gc9NeCnyDDsXBY7dBToJbwHSsckW3 DBEJNaSJsr4ct4mR+W/a3Ny7GYF04gA5WHhKcPGfejTgJoV4c8CJifenSqfinOyOa ysqpk6MqQpk60fl19g== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [192.168.178.29] ([93.207.80.164]) by mail.gmx.net (mrgmx004 [212.227.17.190]) with ESMTPSA (Nemesis) id 1N5GDv-1t4ElN3kwv-00ysVW; Tue, 15 Apr 2025 21:01:24 +0200 Message-ID: <97ceff6a-7803-4053-a1f0-d520f7f00674@gmx.de> Date: Tue, 15 Apr 2025 21:01:22 +0200 MIME-Version: 1.0 User-Agent: Mozilla Thunderbird Newsgroups: gmane.comp.gcc.fortran,gmane.comp.gcc.patches Content-Language: en-US To: fortran , gcc-patches From: Harald Anlauf Subject: [PATCH] Fortran: pure subroutine with pure procedure as dummy [PR106948] X-Provags-ID: V03:K1:egPrF/3Xjvu5lnBhAk/2IDoCcV/5MUhoylUdOU56yJdYjAQPhPe VhCYbS7BJv9vWEhZcR6h7WdUXqQY7obOBEkp+XIDVOa5RytDjB7OePyaveL/opEPaokz1cI azEOi41p+HKaAm/vQYnERQEW1AfNdVn3tUKfgaLkkq4FWe4Vje9bASHHg5jsQrWHUr2RUjc LIGdrXQyAufGPRrRxrm/g== UI-OutboundReport: notjunk:1;M01:P0:hSzFpgh5suc=;PvcZjgZyQnqunEPJXrq2YfrT+mK oFt2ua3d/BTFiHhhKyjg0sPRAoYRPvzvUdrwiV6bibiUSwHVTNJVlPBI1F4PM0iDQJ3vP9o8H l4Wt1Wc60KNELNYQ+D8xIbi10pqjxiEgk9ZigGbnTXLMKD8sprWB9J3hFrGs90eEoDrpNXl/A CrKXabNPjuzZv+Fv19w65/6NmYfvpyrkdBGGwgzMJHILKzI39HCBVpl0mw4/l/ZnLA2aAGnc8 izEUiZlYQupmobde/UylcBU7D9sZKrYhR2+jquP415Q9OWBbV/xGFORJbl/nrI7aWFsD9aXKU kdtIlr/tZ4Dmrtq2jIJ4KcPAYz8TnNoPBCdW7jeYU6zrrS/b5emCFA0/CLnD8rP2m3Kjbi8qP vbIjvy9YpXYhyNl925fPS5lL2wf/7LWvsDc/2Sr11yv/ZI8ksR6UMgAK6Lsc4I4mIEutwV56E tzJ7j/XL9GK87Hnh3g8k7++WbqeewPRMucVrQY7vqRgGGQCWT6TpaDolhg+EM7BmvxxXxZ3rn obM85Uu9nt27U/7c9Os1gSwe4BYvqEeAsgS05DCPTYfSgCF8e1zAYBFbCJ8J7tpst/r1+0HUV 39TEVn5ug6kUzS2LhWQ1uT7iWOUZkYrQgEFc+YYncs3q/0ZCaQtAnuj8ZrA7cfKFAkPIotcbm kZSo1t0m6/+lj4mdyO/43w6f/y6aOBNd92pxg1U2UWejchKAXxwtyy3p2+UisCYhkTD+dAm7k QTd6CwRIdyxO3HeHOyItKtof7+RTZyIHLaON7Lmm7xso6mFT+SwN4b955c4eu//wgIVVXFPbu /qrKEuP3HMJ+F9ubSKIldvz95TV1INqk8nlTIXl2u8Do1KCDYvUhf1K2W+PlxaqtCHzm2SA0O icLWy7k6D4ErLpg0bPjQG02iQu/FnYXLbYNhb9B4pxuhlwff7aKGZwk5ug3L36XM87NgELPsb dGzTmAX1W4CW6cjPGwnTj0vUmZppvbwh6YTAAXiJWC/2dyUFsMMmFYx6yS0czl7Wk/SQg+edz KRp8bdyMAeQ11CZaVkZmHWyE4JmuQgfrRAfNab7mT3nrFwpHCassYasExnRXErG5enkpxr6QZ 3HOAUTOnGP+pp08/5tmoE1ngnDlonSRUWQ1fXWPw1v8JVPGj3GGIAPoAyPqfU+w7STnnRWBus 7YEDa4JLHgrnJs9ElVf7/Hms0Wndq3L3Rg4I4vjAQcx+9yv/Esm+HoYgRopuScmBYzZSXAyH/ KQO6HIB4p4o+aYRnZYvsER62DbbhzSkASo+vORSeuJXLCLt2leF/MTfK79A4WQpmiAj5hBOlA RYiipWEMhjguBiWkVUdN50GvtcHUq/VwDKYFayoHhFGZM2KVnVG7wHYchLq24StAdm3V05Ql2 GOQhl6z4IyC2pobQ02hBlspL9jaVR+fIRdddUA/fNyS4Xa42GM5KPWck1gEGBTE9BAU0Ot8jL elG5anW/wyJ3UKdy8bSUqx8Sx3sObS/ujjAXmq6BMnYSkXTLudNEDp4rQ2S6GdHjJkv1QtUva xgPOraFda/yEZqCUug9lN2eQt3CuHeqWv6gsAUlyssmTDHUm/9Xdh2XfTKRf0sEu556OoQYwq SRdAn6HetmN/jfnq2YWLv12ull6T4pE6tLxyAXevj5A/2GFdecWeMacHCavuKMOvU1ht3Ln4Y fHFwchFe6CSFTqY5+4emorK6PcLn4UIIANtqSFeskow5G9qRvYrr6PKwsT/MT9ggMlteKpCjf NXaBJaZaif/RJNiU1mh91zIMVSf2plDrmgb4nJXFVXtm4RaAo2OUMeeTRvG9N4Xkrxqi+sIoX sLu5LxFXZwqq18qmZXdKYsuIhrCOz0IWRFDBKXBG5Mggg0YpAM+26JKcJGUyCISIpVSTBeqWM +HkbH8c8USxsarEVpIGawzRwhOaRtHC9yYGWstkaW+MRCD5gbXP2IseZQnXWZMuu/f3rxLu2j pnbO+72mqiuZl/W0jQa+y0/j0aOHwyW1XZbvS+6XuMqfgkU4Gfp6SN44GJ9gqv0mWEbUBB3Rz C9azD5oVqE1Urbti9kjIRX2Nhdos/sLcoWbhEL3DMlSuaERlk/6MZCinbjmiDvK+Ys7BcmFSx kFNItSUJil28Iw8AoTY6Wtg59OhuPVkWzn+TMecFENjxYPm0ySJ0ArDu0asFFuM6abIO/U/BT x8VgaG9IojY4HDnvKAL1Hu/zpDGgZZbwTmVRbzWMs1Mx2f8+8hN3jr58RgP5fNtpczHECRjoN OVKJbctnM8Ho3UTuQpfCeFJ++OpeI/kUMHrVKd3qk4m60ppEAk4Eo5T2bjSs3P7o3mdf2xAFt k7+2IQ0g+4q5esR6eGlrZogm54jt2IOdUFoqjtNOLSq8UFttewwTdEKq3Chczq/dZ6E/Nl19G 7Aoqls/vlPxxKTztBcbNKE5taudJfsAZa6OcnhrSOGQPi8UMISJGmGhWio6nrWLnIRloEEgSe EJqxBGidYwFbQ5oy4Q3dC+LlK4RH0ungEahFfkUxJ0rf08HFzk2ya7Wz5ykqdlonKf6YgBkPF +QqNcyzTOK3YKPgMivviUb3tCPCmKGkkkjzcJ/Jvn6prLx1fThf95e6vnSrEtX2DnmMks55IW 5zSy3WUJCcU934Jsv63drOxjdYuA60b9Mqdvaku3/0IzxuPQOa0xm9PnOCPLNBoUIrWA2d3gz bA6eO0EUkyEwf2+jbA7VQEZh4Mlu9iqK258aX8gPblAD+T/giy+eTrEeUcMyANC9z1vuig8jx Ob2eYkfhl16ggKoRXvPrF3M78XYGZ18hYSjBThgA2ABPaxNWJ7Q0FoF7aiuMiuUAhPVKUamMp hJQzDw7HE8sqtR2Z1sJZXsOb78X3RFiJCaATe50rTdNTDI73klrM74LsxikcaymZgThEkZtSw 6QUNvY50QBEOwD6OWOoQAcnnd884KRfeEocELcm97IeWrYLjCTmke4jwunv+bhGi8+B88Us2U nO7Na5F5VCxSOUqcsi0pe7UuplSKqK4ugO1R1ZPorBYRqbPBmKs5SNdA+f8RqW91sHs9Id5xE UrTWOhhds+xtw+0QSFL/pdD/K7U0b+o4gIfjPNEqs6IGCrD98Kxdr4flvdOuhkUQQ== X-Spam-Status: No, score=-12.1 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, 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.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~patchwork=sourceware.org@gcc.gnu.org Dear all, the testcase in the PR shows a case where the pureness of a function is not properly determined, even though the function is resolved, and its attributes clearly show that it is pure, because gfc_pure_function relies on isym or esym being set. This does not happen here, probably because the function is used as a dummy here. The least invasive fix seems to be to look at the symbol's attributes when isym or esym is not set. Regression testing lead to additional redundant error messages for two testcases, so I opted to restrict the change to the case of functions as dummy arguments, making this patch very safe. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald From 5ebb5bb438e8ccf6ea30559604a9f27a75dea0ef Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Tue, 15 Apr 2025 20:43:05 +0200 Subject: [PATCH] Fortran: pure subroutine with pure procedure as dummy [PR106948] PR fortran/106948 gcc/fortran/ChangeLog: * resolve.cc (gfc_pure_function): If a function has been resolved, but esym is not yet set, look at its attributes to see whether it is pure or elemental. gcc/testsuite/ChangeLog: * gfortran.dg/pure_formal_proc_4.f90: New test. --- gcc/fortran/resolve.cc | 7 +++ .../gfortran.dg/pure_formal_proc_4.f90 | 49 +++++++++++++++++++ 2 files changed, 56 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/pure_formal_proc_4.f90 diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index cdf043b6411..410ff685906 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -3190,6 +3190,13 @@ gfc_pure_function (gfc_expr *e, const char **name) || e->value.function.isym->elemental; *name = e->value.function.isym->name; } + else if (e->symtree && e->symtree->n.sym && e->symtree->n.sym->attr.dummy) + { + /* The function has been resolved, but esym is not yet set. + This can happen with functions as dummy argument. */ + pure = e->symtree->n.sym->attr.pure || e->symtree->n.sym->attr.elemental; + *name = e->symtree->n.sym->name; + } else { /* Implicit functions are not pure. */ diff --git a/gcc/testsuite/gfortran.dg/pure_formal_proc_4.f90 b/gcc/testsuite/gfortran.dg/pure_formal_proc_4.f90 new file mode 100644 index 00000000000..92640e2d2f4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pure_formal_proc_4.f90 @@ -0,0 +1,49 @@ +! { dg-do compile } +! PR fortran/106948 - check that passing of PURE procedures works +! +! Contributed by Jim Feng + +module a + implicit none + + interface new + pure module subroutine b(x, f) + integer, intent(inout) :: x + interface + pure function f(x) result(r) + real, intent(in) :: x + real :: r + end function f + end interface + end subroutine b + end interface new +end module a + +submodule(a) a_b + implicit none + +contains + module procedure b + x = int(f(real(x)) * 0.15) + end procedure b +end submodule a_b + +program test + use a + implicit none + + integer :: x + + x = 100 + call new(x, g) + print *, x + +contains + + pure function g(y) result(r) + real, intent(in) :: y + real :: r + + r = sqrt(y) + end function g +end program test -- 2.43.0