[flang-commits] [flang] 2a00d50 - [Flang][OpenACC] Check routine level for function references in loops (#209529)
via flang-commits
flang-commits at lists.llvm.org
Fri Jul 17 07:49:00 PDT 2026
Author: Delaram Talaashrafi
Date: 2026-07-17T10:48:56-04:00
New Revision: 2a00d50e6012e1ee31904d394c088be907b6aa8b
URL: https://github.com/llvm/llvm-project/commit/2a00d50e6012e1ee31904d394c088be907b6aa8b
DIFF: https://github.com/llvm/llvm-project/commit/2a00d50e6012e1ee31904d394c088be907b6aa8b.diff
LOG: [Flang][OpenACC] Check routine level for function references in loops (#209529)
Extend the loop/routine-level compatibility check to `FunctionReference`
calls. Resolve `!$acc routine` information from procedure pointers and
interface symbols, not only `SubprogramDetails`.
Added:
Modified:
flang/lib/Semantics/check-acc-structure.cpp
flang/lib/Semantics/check-acc-structure.h
flang/test/Semantics/OpenACC/acc-loop-routine-call.f90
Removed:
################################################################################
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..5b5a46ed7e571 100644
--- a/flang/test/Semantics/OpenACC/acc-loop-routine-call.f90
+++ b/flang/test/Semantics/OpenACC/acc-loop-routine-call.f90
@@ -34,13 +34,52 @@ 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
+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
+ integer :: i, j
+ real :: a(8)
+
+ a = 0.0
!$acc parallel
!$acc loop vector
@@ -49,6 +88,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 +127,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 +173,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 +220,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 +276,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)
@@ -215,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