[flang-commits] [flang] [flang][test] Extend coverage for procedure-valued function results (PR #219477)

Eugene Epshteyn via flang-commits flang-commits at lists.llvm.org
Fri Aug 28 06:59:24 PDT 2026


https://github.com/eugeneepshteyn created https://github.com/llvm/llvm-project/pull/219477

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.

**`flang/test/Semantics/func-proc-result-callees.f90`** — one shape per callee-resolution path that `FindFunctionResult` walks: interface block, dummy procedure, host association, `ENTRY`, type-bound procedure, generic, procedure-pointer entity, and procedure-pointer component. Each of these shapes was confirmed to hit the abort before the fix and to produce an accurate diagnostic after it, so the file discriminates rather than merely passing.

**`flang/test/Semantics/func-proc-result-valid.f90`** — a valid-code guard. `IsProcedure(const Expr<SomeType> &)` is used only in the reject direction by all of its callers, so any further widening of the predicate could only surface as a *new rejection of conforming code*, which no error-expecting test would catch. This no-error file covers the callee and result flavors the 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.

Test-only change; no functional change. Both files were validated with the suite's own `test_errors.py` and `check-flang` is clean.


>From a2559ca04ae2165cf06f3a47e3d648f78d74f7ce Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Fri, 28 Aug 2026 09:57:35 -0400
Subject: [PATCH] [flang][test] Extend coverage for procedure-valued function
 results

#216322 fixed IsProcedure() for references to functions whose result is a
plain procedure, a shape that previously aborted a production build in
intrinsic argument checking. The tests that landed with it all reference
the callee directly and recursively, or vary the intrinsic; add two files
pinning the dimensions they leave uncovered.

func-proc-result-callees.f90 exercises one shape per callee-resolution
path that FindFunctionResult walks: interface block, dummy procedure,
host association, ENTRY, type-bound procedure, generic, procedure-pointer
entity, and procedure-pointer component.

func-proc-result-valid.f90 is a valid-code guard. IsProcedure(Expr) is
used only in the reject direction, so a further widening of it could only
surface as a new rejection of conforming code; this no-error file covers
the callee and result flavors the function-reference branch walks.

Test-only change; no functional change.
---
 .../Semantics/func-proc-result-callees.f90    | 108 ++++++++++++++
 .../test/Semantics/func-proc-result-valid.f90 | 136 ++++++++++++++++++
 2 files changed, 244 insertions(+)
 create mode 100644 flang/test/Semantics/func-proc-result-callees.f90
 create mode 100644 flang/test/Semantics/func-proc-result-valid.f90

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



More information about the flang-commits mailing list