[flang-commits] [flang] [Flang][OpenACC] Check routine level for function references in loops (PR #209529)

Delaram Talaashrafi via flang-commits flang-commits at lists.llvm.org
Fri Jul 17 07:21:38 PDT 2026


https://github.com/delaram-talaashrafi updated https://github.com/llvm/llvm-project/pull/209529

>From b93ad4262a695824b7660d882502f081a6bdd47d Mon Sep 17 00:00:00 2001
From: Delaram Talaashrafi <dtalaashrafi at rome5.pgi.net>
Date: Tue, 14 Jul 2026 08:51:07 -0700
Subject: [PATCH 1/2] [Flang][OpenACC] Check routine level for function
 references in loops

Extend the loop/routine-level compatibility check beyond to FunctionReference calls.
Resolve !$acc routine information from procedure pointers and interface symbols, not
only SubprogramDetails.
---
 flang/lib/Semantics/check-acc-structure.cpp   | 65 +++++++++++--
 flang/lib/Semantics/check-acc-structure.h     |  2 +
 .../OpenACC/acc-loop-routine-call.f90         | 94 ++++++++++++++++++-
 3 files changed, 151 insertions(+), 10 deletions(-)

diff --git a/flang/lib/Semantics/check-acc-structure.cpp b/flang/lib/Semantics/check-acc-structure.cpp
index 759537d5baba5..e902a0b31df01 100644
--- a/flang/lib/Semantics/check-acc-structure.cpp
+++ b/flang/lib/Semantics/check-acc-structure.cpp
@@ -349,22 +349,40 @@ void AccStructureChecker::CheckNotInSameOrSubLevelLoopConstruct() {
   }
 }
 
-void AccStructureChecker::Enter(const parser::CallStmt &call) {
-  if (dirContext_.empty() || !call.typedCall) {
+void AccStructureChecker::CheckRoutineCallInLoop(const Symbol &symbol) {
+  if (dirContext_.empty()) {
     return;
   }
-  const Symbol *sym{call.typedCall->proc().GetSymbol()};
-  if (!sym) {
-    return;
+  // OpenACC routine information can be attached either to a SubprogramDetails
+  // (a normal function/subroutine) or to a ProcEntityDetails (a procedure
+  // pointer or dummy procedure).
+  auto getRoutineInfos =
+      [](const Symbol &sym) -> const std::vector<OpenACCRoutineInfo> * {
+    if (const auto *subp{sym.detailsIf<SubprogramDetails>()}) {
+      return &subp->openACCRoutineInfos();
+    }
+    if (const auto *proc{sym.detailsIf<ProcEntityDetails>()}) {
+      return &proc->openACCRoutineInfos();
+    }
+    return nullptr;
+  };
+
+  const Symbol &ult{symbol.GetUltimate()};
+  const std::vector<OpenACCRoutineInfo> *infos{getRoutineInfos(ult)};
+  // For a call made through a procedure pointer or binding whose routine level
+  // is declared on its interface rather than on the pointer itself, follow the
+  // interface to pick up the routine information.
+  if (!infos || infos->empty()) {
+    if (const Symbol *subpSym{FindSubprogram(ult)}) {
+      infos = getRoutineInfos(*subpSym);
+    }
   }
-  const Symbol &ult{sym->GetUltimate()};
-  const auto *subp{ult.detailsIf<SubprogramDetails>()};
-  if (!subp || subp->openACCRoutineInfos().empty()) {
+  if (!infos || infos->empty()) {
     return;
   }
   std::string routineParDim;
   unsigned routineGangDim = 0;
-  for (const OpenACCRoutineInfo &ri : subp->openACCRoutineInfos()) {
+  for (const OpenACCRoutineInfo &ri : *infos) {
     if (ri.isGang()) {
       if (unsigned gangDim = ri.gangDim()) {
         routineGangDim = gangDim;
@@ -418,6 +436,35 @@ void AccStructureChecker::Enter(const parser::CallStmt &call) {
   }
 }
 
+void AccStructureChecker::Enter(const parser::CallStmt &call) {
+  if (!call.typedCall) {
+    return;
+  }
+  const Symbol *sym{call.typedCall->proc().GetSymbol()};
+  if (!sym) {
+    return;
+  }
+  CheckRoutineCallInLoop(*sym);
+}
+
+void AccStructureChecker::Enter(const parser::FunctionReference &ref) {
+  auto &proc{std::get<parser::ProcedureDesignator>(ref.v.t)};
+  const Symbol *sym{common::visit(
+      common::visitors{
+          [](const parser::Name &x) { return x.symbol; },
+          [](const parser::ProcComponentRef &x) {
+            return parser::UnwrapRef<parser::StructureComponent>(x.v)
+                .Component()
+                .symbol;
+          },
+      },
+      proc.u)};
+  if (!sym) {
+    return;
+  }
+  CheckRoutineCallInLoop(*sym);
+}
+
 void AccStructureChecker::Enter(const parser::OpenACCLoopConstruct &x) {
   const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
   const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};
diff --git a/flang/lib/Semantics/check-acc-structure.h b/flang/lib/Semantics/check-acc-structure.h
index b040e14642ac9..31984519dd93d 100644
--- a/flang/lib/Semantics/check-acc-structure.h
+++ b/flang/lib/Semantics/check-acc-structure.h
@@ -79,6 +79,7 @@ class AccStructureChecker
   void Enter(const parser::DoConstruct &);
   void Leave(const parser::DoConstruct &);
   void Enter(const parser::CallStmt &);
+  void Enter(const parser::FunctionReference &);
 
 #define GEN_FLANG_CLAUSE_CHECK_ENTER
 #include "llvm/Frontend/OpenACC/ACC.inc"
@@ -107,6 +108,7 @@ class AccStructureChecker
   std::optional<std::int64_t> getGangDimensionSize(
       DirectiveContext &dirContext);
   void CheckNotInSameOrSubLevelLoopConstruct();
+  void CheckRoutineCallInLoop(const Symbol &);
   void CheckMultipleOccurrenceInDeclare(
       const parser::AccObjectList &, llvm::acc::Clause);
   void CheckMultipleOccurrenceInDeclare(
diff --git a/flang/test/Semantics/OpenACC/acc-loop-routine-call.f90 b/flang/test/Semantics/OpenACC/acc-loop-routine-call.f90
index 428bb5f4dc0e2..933a03cf00430 100644
--- a/flang/test/Semantics/OpenACC/acc-loop-routine-call.f90
+++ b/flang/test/Semantics/OpenACC/acc-loop-routine-call.f90
@@ -34,13 +34,43 @@ subroutine r_gang_dim3()
     !$acc routine gang(dim:3)
   end subroutine r_gang_dim3
 
+  integer function f_seq(x)
+    integer, intent(in) :: x
+    !$acc routine seq
+    f_seq = x
+  end function f_seq
+
+  integer function f_vector(x)
+    integer, intent(in) :: x
+    !$acc routine vector
+    f_vector = x
+  end function f_vector
+
+  integer function f_worker(x)
+    integer, intent(in) :: x
+    !$acc routine worker
+    f_worker = x
+  end function f_worker
+
+  integer function f_gang(x)
+    integer, intent(in) :: x
+    !$acc routine gang
+    f_gang = x
+  end function f_gang
+
+  integer function f_gang_dim3(x)
+    integer, intent(in) :: x
+    !$acc routine gang(dim:3)
+    f_gang_dim3 = x
+  end function f_gang_dim3
+
 end module acc_loop_routine_call_m
 
 program acc_loop_routine_call
   use acc_loop_routine_call_m
   implicit none
   integer, parameter :: n = 8
-  integer :: i
+  integer :: i, j
 
   !$acc parallel
   !$acc loop vector
@@ -49,6 +79,13 @@ program acc_loop_routine_call
   end do
   !$acc end parallel
 
+  !$acc parallel
+  !$acc loop vector
+  do i = 1, n
+    j = f_seq(i)
+  end do
+  !$acc end parallel
+
   !$acc parallel
   !ERROR: Calling GANG routine inside VECTOR loop is not allowed
   !$acc loop vector
@@ -81,6 +118,30 @@ program acc_loop_routine_call
   end do
   !$acc end parallel
 
+  !$acc parallel
+  !ERROR: Calling VECTOR routine inside VECTOR loop is not allowed
+  !$acc loop vector
+  do i = 1, n
+    j = f_vector(i)
+  end do
+  !$acc end parallel
+
+  !$acc parallel
+  !ERROR: Calling WORKER routine inside VECTOR loop is not allowed
+  !$acc loop vector
+  do i = 1, n
+    j = f_worker(i)
+  end do
+  !$acc end parallel
+
+  !$acc parallel
+  !ERROR: Calling GANG routine inside VECTOR loop is not allowed
+  !$acc loop vector
+  do i = 1, n
+    j = f_gang(i)
+  end do
+  !$acc end parallel
+
   !$acc parallel
   !ERROR: Calling GANG(3) routine inside VECTOR loop is not allowed
   !$acc loop vector
@@ -103,6 +164,13 @@ program acc_loop_routine_call
   end do
   !$acc end parallel
 
+  !$acc parallel
+  !$acc loop worker
+  do i = 1, n
+    j = f_vector(i)
+  end do
+  !$acc end parallel
+
   !$acc parallel
   !ERROR: Calling GANG routine inside WORKER loop is not allowed
   !$acc loop worker
@@ -143,6 +211,22 @@ program acc_loop_routine_call
   end do
   !$acc end parallel
 
+  !$acc parallel
+  !ERROR: Calling WORKER routine inside WORKER loop is not allowed
+  !$acc loop worker
+  do i = 1, n
+    j = f_worker(i)
+  end do
+  !$acc end parallel
+
+  !$acc parallel
+  !ERROR: Calling GANG routine inside WORKER loop is not allowed
+  !$acc loop worker
+  do i = 1, n
+    j = f_gang(i)
+  end do
+  !$acc end parallel
+
   !$acc parallel
   !$acc loop gang(dim:2)
   do i = 1, n
@@ -183,6 +267,14 @@ program acc_loop_routine_call
   end do
   !$acc end parallel
 
+  !$acc parallel
+  !ERROR: Calling GANG(3) routine inside GANG(2) loop is not allowed
+  !$acc loop gang(dim:2)
+  do i = 1, n
+    j = f_gang_dim3(i)
+  end do
+  !$acc end parallel
+
   !$acc parallel
   !ERROR: Calling GANG(2) routine inside GANG(2) loop is not allowed
   !$acc loop gang(dim:2)

>From 6eac18f0f285ed8ec21390b3e8618c912ffe1893 Mon Sep 17 00:00:00 2001
From: Delaram Talaashrafi <dtalaashrafi at rome5.pgi.net>
Date: Fri, 17 Jul 2026 07:20:41 -0700
Subject: [PATCH 2/2] Test update

---
 .../OpenACC/acc-loop-routine-call.f90         | 32 +++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/flang/test/Semantics/OpenACC/acc-loop-routine-call.f90 b/flang/test/Semantics/OpenACC/acc-loop-routine-call.f90
index 933a03cf00430..5b5a46ed7e571 100644
--- a/flang/test/Semantics/OpenACC/acc-loop-routine-call.f90
+++ b/flang/test/Semantics/OpenACC/acc-loop-routine-call.f90
@@ -66,11 +66,20 @@ end function f_gang_dim3
 
 end module acc_loop_routine_call_m
 
+subroutine case4_routine_dim_arg()
+  use acc_loop_routine_call_m
+  !ERROR: Calling GANG routine inside GANG loop is not allowed
+  !$acc routine gang(dim: f_gang(1))
+end subroutine case4_routine_dim_arg
+
 program acc_loop_routine_call
   use acc_loop_routine_call_m
   implicit none
   integer, parameter :: n = 8
   integer :: i, j
+  real :: a(8)
+
+  a = 0.0
 
   !$acc parallel
   !$acc loop vector
@@ -307,4 +316,27 @@ program acc_loop_routine_call
   end do
   !$acc end parallel
 
+  ! Check firing outside loop-body execution:
+  !$acc kernels
+  !ERROR: Calling GANG routine inside VECTOR loop is not allowed
+  !$acc loop vector(f_gang(n))
+  do i = 1, n
+    j = i
+  end do
+  !$acc end kernels
+
+  !$acc parallel
+  !ERROR: Calling GANG routine inside VECTOR loop is not allowed
+  !$acc loop vector
+  do i = 1, f_gang(n)
+    j = i
+  end do
+  !$acc end parallel
+
+  !ERROR: Calling GANG routine inside VECTOR loop is not allowed
+  !$acc parallel loop vector if(f_gang(n) > 0)
+  do i = 1, n
+    a(i) = a(i) + 1.0
+  end do
+
 end program acc_loop_routine_call



More information about the flang-commits mailing list