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 <anl...@gmx.de>
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
