[flang-commits] [flang] [flang][test] Extend coverage for procedure-valued function results (PR #219477)
via flang-commits
flang-commits at lists.llvm.org
Fri Aug 28 12:02:52 PDT 2026
llvmorg-github-actions[bot] wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Eugene Epshteyn (eugeneepshteyn)
<details>
<summary>Changes</summary>
Follow-up test coverage for #<!-- -->216322, which fixed `IsProcedure()` for references to functions whose result is a plain procedure — a shape that previously aborted a production build on the `CHECK(IsProcedure(expr) || IsProcedurePointer(expr))` in intrinsic argument checking instead of reporting the declaration error flang had already recorded.
The tests that landed with that fix reference the callee directly and recursively (`func-proc-result.f90`) or vary the intrinsic (`func-proc-result-intrinsics.f90`). This adds the two dimensions they leave uncovered.
Assisted-by: AI
---
Full diff: https://github.com/llvm/llvm-project/pull/219477.diff
2 Files Affected:
- (added) flang/test/Semantics/func-proc-result-callees.f90 (+108)
- (added) flang/test/Semantics/func-proc-result-valid.f90 (+136)
``````````diff
diff --git a/flang/test/Semantics/func-proc-result-callees.f90 b/flang/test/Semantics/func-proc-result-callees.f90
new file mode 100644
index 0000000000000..ee59d5f266bfc
--- /dev/null
+++ b/flang/test/Semantics/func-proc-result-callees.f90
@@ -0,0 +1,108 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! References to functions whose results are plain procedures (invalid:
+! a function result is either a variable or a procedure pointer, F2023
+! 19.3.3), with the callee resolved through every FindFunctionResult path:
+! interface block, dummy procedure, host association, ENTRY, type-bound
+! procedure, generic, procedure-pointer entity, procedure-pointer component.
+
+! Interface-block callee; reference is an output item.
+subroutine s1()
+ interface
+ function g1() result(r)
+ !ERROR: A function result may not be a procedure unless it is a procedure pointer
+ procedure() :: r
+ end function
+ end interface
+ !ERROR: Output item must not be a procedure
+ print *, g1()
+end
+
+! Dummy-procedure callee.
+subroutine s2(dp)
+ interface
+ function g2(x) result(r)
+ real :: x
+ !ERROR: A function result may not be a procedure unless it is a procedure pointer
+ procedure() :: r
+ end function
+ end interface
+ procedure(g2) :: dp
+ !ERROR: Actual argument for 'array=' may not be a procedure
+ print *, size(dp(1.0))
+end
+
+! Host-associated callee.
+subroutine s3()
+contains
+ function g3(x) result(r)
+ !ERROR: A function result may not be a procedure unless it is a procedure pointer
+ procedure() :: r
+ real :: x
+ end function
+ subroutine inner
+ !ERROR: Actual argument for 'array=' may not be a procedure
+ print *, size(g3(1.0))
+ end subroutine
+end
+
+! ENTRY result.
+function s4(x)
+ real :: s4, x
+ !ERROR: A function result may not be a procedure unless it is a procedure pointer
+ procedure() :: j
+ !ERROR: Actual argument for 'array=' may not be a procedure
+ print *, size(e4(1.0))
+ s4 = x
+ return
+ !ERROR: Result of ENTRY is not compatible with result of containing function
+ entry e4(x) result(j)
+end function
+
+! Type-bound callee (ProcBindingDetails) and generic-resolved callee.
+module m5
+ type t5
+ contains
+ procedure, nopass :: tbp => g5
+ end type
+ interface gen5
+ module procedure g5
+ end interface
+contains
+ function g5(x) result(i)
+ real, intent(in) :: x
+ !ERROR: A function result may not be a procedure unless it is a procedure pointer
+ procedure() :: i
+ end function
+end module
+
+subroutine s5()
+ use m5
+ type(t5) :: x
+ !ERROR: Actual argument for 'array=' may not be a procedure
+ print *, size(x%tbp(1.0))
+ !ERROR: Actual argument for 'array=' may not be a procedure
+ print *, size(gen5(1.0))
+end
+
+! Procedure-pointer entity callee and proc-pointer component callee.
+module m6
+ interface
+ function g6(y) result(r)
+ !ERROR: A function result may not be a procedure unless it is a procedure pointer
+ procedure() :: r
+ end function
+ end interface
+ type t6
+ procedure(g6), pointer, nopass :: pc
+ end type
+end module
+
+subroutine s6()
+ use m6
+ procedure(g6), pointer :: pp
+ type(t6) :: x
+ !ERROR: Actual argument for 'array=' may not be a procedure
+ print *, size(pp(1.0))
+ !ERROR: Actual argument for 'array=' may not be a procedure
+ print *, size(x%pc(1.0))
+end
diff --git a/flang/test/Semantics/func-proc-result-valid.f90 b/flang/test/Semantics/func-proc-result-valid.f90
new file mode 100644
index 0000000000000..31b3cf08fb9e1
--- /dev/null
+++ b/flang/test/Semantics/func-proc-result-valid.f90
@@ -0,0 +1,136 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Valid-code guard for IsProcedure(Expr): function references with every
+! callee/result flavor that the predicate's function-reference branch walks
+! (statement functions, data-pointer results, procedure pointers, dummy
+! procedures, type-bound and generic callees, ENTRY results, recursive
+! references, and procedure-pointer-valued function results in their
+! conforming uses) must all still be accepted.
+! No errors expected anywhere in this file.
+
+module m
+ integer, target :: itgt = 9
+ type t
+ contains
+ procedure :: tbp
+ end type
+ interface gen
+ module procedure fi, fr
+ end interface
+ interface operator(.plus.)
+ module procedure add
+ end interface
+contains
+ integer function fi(i)
+ integer, intent(in) :: i
+ fi = i
+ end function
+ real function fr(r)
+ real, intent(in) :: r
+ fr = r
+ end function
+ integer function tbp(this)
+ class(t), intent(in) :: this
+ tbp = 3
+ end function
+ integer function add(a, b)
+ integer, intent(in) :: a, b
+ add = a + b
+ end function
+ function fp() result(r)
+ integer, pointer :: r
+ allocate(r)
+ r = 5
+ end function
+ function fpa() result(r)
+ integer, pointer :: r(:)
+ allocate(r(3))
+ r = 7
+ end function
+ character(5) function cf()
+ cf = 'hello'
+ end function
+ function af() result(r)
+ integer :: r(3)
+ r = [1, 2, 3]
+ end function
+ elemental integer function ef(i)
+ integer, intent(in) :: i
+ ef = i * 2
+ end function
+ integer function fent()
+ integer :: gent
+ fent = 1
+ return
+ entry gent()
+ gent = 2
+ end function
+ function polya() result(r)
+ class(*), allocatable :: r
+ r = 42
+ end function
+ function polyp() result(r)
+ class(*), pointer :: r
+ r => itgt
+ end function
+ integer function target1()
+ target1 = 7
+ end function
+ function getp() result(r)
+ procedure(target1), pointer :: r
+ r => target1
+ end function
+end module
+
+recursive function fact(n) result(r)
+ integer, intent(in) :: n
+ integer :: r
+ if (n <= 1) then
+ r = 1
+ else
+ r = n * fact(n - 1)
+ end if
+ print *, fact(1)
+end function
+
+subroutine dummyproc(g)
+ use m, only: fi
+ procedure(fi) :: g
+ print *, g(1)
+end
+
+program p
+ use m
+ use m, only: renamed => fi
+ procedure(target1), pointer :: q
+ type(t) :: x
+ real :: sf, xx
+ external impf
+ real impf
+ sf(xx) = xx + 1.0
+ print *, sf(2.0)
+ print *, fp(), size(fpa())
+ print *, x%tbp()
+ print *, gen(1), gen(1.5)
+ print *, 1 .plus. 2
+ print *, renamed(4)
+ print *, fent(), gent()
+ print *, cf(), af(), ef([1, 2, 3]), size(af())
+ print *, impf()
+ select type (y => polya())
+ type is (integer)
+ print *, y
+ end select
+ select type (y => polyp())
+ type is (integer)
+ print *, y
+ end select
+ q => getp()
+ print *, q()
+ print *, associated(getp(), target1)
+ call take(getp())
+contains
+ subroutine take(d)
+ procedure(target1) :: d
+ print *, d()
+ end subroutine
+end
``````````
</details>
https://github.com/llvm/llvm-project/pull/219477
More information about the flang-commits
mailing list