[flang-commits] [flang] [flang][OpenACC] Support acc routine info on ProcEntityDetails for separate compilation (PR #192367)
via flang-commits
flang-commits at lists.llvm.org
Fri Apr 17 09:51:46 PDT 2026
https://github.com/khaki3 updated https://github.com/llvm/llvm-project/pull/192367
>From 0c4d396867c713e559b202ccafa3baf014180e27 Mon Sep 17 00:00:00 2001
From: Kazuaki Matsumura <kmatsumura at nvidia.com>
Date: Fri, 17 Apr 2026 09:51:35 -0700
Subject: [PATCH] [flang][OpenACC] Support acc routine info on
ProcEntityDetails for separate compilation
When !$acc routine(name) vector is used in a caller for an external
subroutine, the symbol has ProcEntityDetails (not SubprogramDetails).
The routine info (vector/worker/gang/seq) was silently lost because
AddRoutineInfoToSymbol only handled SubprogramDetails, and
CallInterface only checked SubprogramDetails for openACCRoutineInfos.
Add openACCRoutineInfos storage to ProcEntityDetails and handle it
in both AddRoutineInfoToSymbol and CallInterface so the parallelism
level is properly lowered to acc.routine with the correct keyword.
Made-with: Cursor
---
flang/include/flang/Semantics/symbol.h | 7 +
flang/lib/Lower/CallInterface.cpp | 16 +-
flang/lib/Semantics/resolve-directives.cpp | 139 +++++++++---------
.../OpenACC/acc-routine-named-external.f90 | 72 +++++++++
4 files changed, 161 insertions(+), 73 deletions(-)
create mode 100644 flang/test/Lower/OpenACC/acc-routine-named-external.f90
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 4c422ac5f471a..775ac5ca3dcbc 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -475,6 +475,12 @@ class ProcEntityDetails : public EntityDetails, public WithPassArg {
return usedAsProcedureHere_;
}
void set_usedAsProcedureHere(SourceName here) { usedAsProcedureHere_ = here; }
+ const std::vector<OpenACCRoutineInfo> &openACCRoutineInfos() const {
+ return openACCRoutineInfos_;
+ }
+ void add_openACCRoutineInfo(OpenACCRoutineInfo info) {
+ openACCRoutineInfos_.push_back(info);
+ }
private:
const Symbol *rawProcInterface_{nullptr};
@@ -482,6 +488,7 @@ class ProcEntityDetails : public EntityDetails, public WithPassArg {
std::optional<const Symbol *> init_;
bool isCUDAKernel_{false};
std::optional<SourceName> usedAsProcedureHere_;
+ std::vector<OpenACCRoutineInfo> openACCRoutineInfos_;
friend llvm::raw_ostream &operator<<(
llvm::raw_ostream &, const ProcEntityDetails &);
};
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 129f71a027451..cd94f4d363061 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -718,12 +718,18 @@ void Fortran::lower::CallInterface<T>::declare() {
setCUDAAttributes(func, side().getProcedureSymbol(), characteristic);
if (const Fortran::semantics::Symbol *sym = side().getProcedureSymbol()) {
- if (const auto &info{
- sym->GetUltimate()
- .detailsIf<Fortran::semantics::SubprogramDetails>()}) {
- if (!info->openACCRoutineInfos().empty()) {
+ const Fortran::semantics::Symbol &ultimate{sym->GetUltimate()};
+ if (const auto *subpDetails{
+ ultimate.detailsIf<Fortran::semantics::SubprogramDetails>()}) {
+ if (!subpDetails->openACCRoutineInfos().empty()) {
genOpenACCRoutineConstruct(converter, module, func,
- info->openACCRoutineInfos());
+ subpDetails->openACCRoutineInfos());
+ }
+ } else if (const auto *procDetails{ultimate.detailsIf<
+ Fortran::semantics::ProcEntityDetails>()}) {
+ if (!procDetails->openACCRoutineInfos().empty()) {
+ genOpenACCRoutineConstruct(converter, module, func,
+ procDetails->openACCRoutineInfos());
}
}
}
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index c50c76647962c..ee19849f65fb5 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -1405,84 +1405,87 @@ MaybeExpr EvaluateExpr(
void AccAttributeVisitor::AddRoutineInfoToSymbol(
Symbol &symbol, const parser::OpenACCRoutineConstruct &x) {
- if (symbol.has<SubprogramDetails>()) {
- Fortran::semantics::OpenACCRoutineInfo info;
- std::vector<OpenACCRoutineDeviceTypeInfo *> currentDevices;
- currentDevices.push_back(&info);
- const auto &clauses{std::get<Fortran::parser::AccClauseList>(x.t)};
- for (const Fortran::parser::AccClause &clause : clauses.v) {
- if (const auto *dTypeClause{
- std::get_if<Fortran::parser::AccClause::DeviceType>(&clause.u)}) {
- currentDevices.clear();
- for (const auto &deviceTypeExpr : dTypeClause->v.v) {
- currentDevices.push_back(&info.add_deviceTypeInfo(deviceTypeExpr.v));
- }
- } else if (std::get_if<Fortran::parser::AccClause::Nohost>(&clause.u)) {
- info.set_isNohost();
- } else if (std::get_if<Fortran::parser::AccClause::Seq>(&clause.u)) {
- for (auto &device : currentDevices) {
- device->set_isSeq();
- }
- } else if (std::get_if<Fortran::parser::AccClause::Vector>(&clause.u)) {
- for (auto &device : currentDevices) {
- device->set_isVector();
- }
- } else if (std::get_if<Fortran::parser::AccClause::Worker>(&clause.u)) {
- for (auto &device : currentDevices) {
- device->set_isWorker();
- }
- } else if (const auto *gangClause{
- std::get_if<Fortran::parser::AccClause::Gang>(
- &clause.u)}) {
- for (auto &device : currentDevices) {
- device->set_isGang();
- }
- if (gangClause->v) {
- const Fortran::parser::AccGangArgList &x = *gangClause->v;
- int numArgs{0};
- for (const Fortran::parser::AccGangArg &gangArg : x.v) {
- CHECK(numArgs <= 1 && "expecting 0 or 1 gang dim args");
- if (const auto *dim{std::get_if<Fortran::parser::AccGangArg::Dim>(
- &gangArg.u)}) {
- if (const auto v{EvaluateInt64(context_, dim->v)}) {
- for (auto &device : currentDevices) {
- device->set_gangDim(*v);
- }
+ if (!symbol.has<SubprogramDetails>() && !symbol.has<ProcEntityDetails>())
+ return;
+ Fortran::semantics::OpenACCRoutineInfo info;
+ std::vector<OpenACCRoutineDeviceTypeInfo *> currentDevices;
+ currentDevices.push_back(&info);
+ const auto &clauses{std::get<Fortran::parser::AccClauseList>(x.t)};
+ for (const Fortran::parser::AccClause &clause : clauses.v) {
+ if (const auto *dTypeClause{
+ std::get_if<Fortran::parser::AccClause::DeviceType>(&clause.u)}) {
+ currentDevices.clear();
+ for (const auto &deviceTypeExpr : dTypeClause->v.v) {
+ currentDevices.push_back(&info.add_deviceTypeInfo(deviceTypeExpr.v));
+ }
+ } else if (std::get_if<Fortran::parser::AccClause::Nohost>(&clause.u)) {
+ info.set_isNohost();
+ } else if (std::get_if<Fortran::parser::AccClause::Seq>(&clause.u)) {
+ for (auto &device : currentDevices) {
+ device->set_isSeq();
+ }
+ } else if (std::get_if<Fortran::parser::AccClause::Vector>(&clause.u)) {
+ for (auto &device : currentDevices) {
+ device->set_isVector();
+ }
+ } else if (std::get_if<Fortran::parser::AccClause::Worker>(&clause.u)) {
+ for (auto &device : currentDevices) {
+ device->set_isWorker();
+ }
+ } else if (const auto *gangClause{
+ std::get_if<Fortran::parser::AccClause::Gang>(
+ &clause.u)}) {
+ for (auto &device : currentDevices) {
+ device->set_isGang();
+ }
+ if (gangClause->v) {
+ const Fortran::parser::AccGangArgList &x = *gangClause->v;
+ int numArgs{0};
+ for (const Fortran::parser::AccGangArg &gangArg : x.v) {
+ CHECK(numArgs <= 1 && "expecting 0 or 1 gang dim args");
+ if (const auto *dim{std::get_if<Fortran::parser::AccGangArg::Dim>(
+ &gangArg.u)}) {
+ if (const auto v{EvaluateInt64(context_, dim->v)}) {
+ for (auto &device : currentDevices) {
+ device->set_gangDim(*v);
}
}
- numArgs++;
}
+ numArgs++;
}
- } else if (const auto *bindClause{
- std::get_if<Fortran::parser::AccClause::Bind>(
- &clause.u)}) {
- if (const auto *name{
- std::get_if<Fortran::parser::Name>(&bindClause->v.u)}) {
- if (Symbol * sym{ResolveFctName(*name)}) {
- Symbol &ultimate{sym->GetUltimate()};
- for (auto &device : currentDevices) {
- device->set_bindName(SymbolRef{ultimate});
- }
- } else {
- context_.Say((*name).source,
- "No function or subroutine declared for '%s'"_err_en_US,
- (*name).source);
- }
- } else if (const auto charExpr{
- std::get_if<Fortran::parser::ScalarDefaultCharExpr>(
- &bindClause->v.u)}) {
- auto *charConst{
- Fortran::parser::Unwrap<Fortran::parser::CharLiteralConstant>(
- *charExpr)};
- std::string str{std::get<std::string>(charConst->t)};
+ }
+ } else if (const auto *bindClause{
+ std::get_if<Fortran::parser::AccClause::Bind>(
+ &clause.u)}) {
+ if (const auto *name{
+ std::get_if<Fortran::parser::Name>(&bindClause->v.u)}) {
+ if (Symbol * sym{ResolveFctName(*name)}) {
+ Symbol &ultimate{sym->GetUltimate()};
for (auto &device : currentDevices) {
- device->set_bindName(std::string(str));
+ device->set_bindName(SymbolRef{ultimate});
}
+ } else {
+ context_.Say((*name).source,
+ "No function or subroutine declared for '%s'"_err_en_US,
+ (*name).source);
+ }
+ } else if (const auto charExpr{
+ std::get_if<Fortran::parser::ScalarDefaultCharExpr>(
+ &bindClause->v.u)}) {
+ auto *charConst{
+ Fortran::parser::Unwrap<Fortran::parser::CharLiteralConstant>(
+ *charExpr)};
+ std::string str{std::get<std::string>(charConst->t)};
+ for (auto &device : currentDevices) {
+ device->set_bindName(std::string(str));
}
}
}
- symbol.get<SubprogramDetails>().add_openACCRoutineInfo(info);
}
+ if (symbol.has<SubprogramDetails>())
+ symbol.get<SubprogramDetails>().add_openACCRoutineInfo(info);
+ else
+ symbol.get<ProcEntityDetails>().add_openACCRoutineInfo(info);
}
bool AccAttributeVisitor::Pre(const parser::OpenACCRoutineConstruct &x) {
diff --git a/flang/test/Lower/OpenACC/acc-routine-named-external.f90 b/flang/test/Lower/OpenACC/acc-routine-named-external.f90
new file mode 100644
index 0000000000000..3fb362b2974d0
--- /dev/null
+++ b/flang/test/Lower/OpenACC/acc-routine-named-external.f90
@@ -0,0 +1,72 @@
+! Test that !$acc routine(name) with parallelism clauses for external
+! subroutines correctly produces acc.routine with the keyword, even
+! when the callee is a ProcEntity (not SubprogramDetails).
+
+! RUN: bbc -fopenacc -emit-hlfir %s -o - | FileCheck %s
+
+! CHECK-DAG: acc.routine @{{.*}} func(@_QPext_vec) vector
+! CHECK-DAG: acc.routine @{{.*}} func(@_QPext_worker) worker
+! CHECK-DAG: acc.routine @{{.*}} func(@_QPext_gang) gang
+! CHECK-DAG: acc.routine @{{.*}} func(@_QPext_seq) seq
+
+subroutine caller_vec(a, n)
+ integer, intent(in) :: n
+ real, intent(inout) :: a(n)
+ integer :: k
+ !$acc routine(ext_vec) vector
+ !$acc parallel loop gang
+ do k = 1, 10
+ call ext_vec(a, n)
+ end do
+end subroutine
+
+subroutine caller_worker(a, n)
+ integer, intent(in) :: n
+ real, intent(inout) :: a(n)
+ integer :: k
+ !$acc routine(ext_worker) worker
+ !$acc parallel loop gang
+ do k = 1, 10
+ call ext_worker(a, n)
+ end do
+end subroutine
+
+subroutine caller_gang(a, n)
+ integer, intent(in) :: n
+ real, intent(inout) :: a(n)
+ !$acc routine(ext_gang) gang
+ !$acc parallel
+ call ext_gang(a, n)
+ !$acc end parallel
+end subroutine
+
+subroutine caller_seq(a, n)
+ integer, intent(in) :: n
+ real, intent(inout) :: a(n)
+ integer :: k
+ !$acc routine(ext_seq) seq
+ !$acc parallel loop gang vector
+ do k = 1, 10
+ call ext_seq(a, n)
+ end do
+end subroutine
+
+! Test with explicit interface block (SubprogramDetails path).
+! CHECK-DAG: acc.routine @{{.*}} func(@_QPext_iface) vector
+
+subroutine caller_iface(a, n)
+ integer, intent(in) :: n
+ real, intent(inout) :: a(n)
+ integer :: k
+ !$acc routine(ext_iface) vector
+ interface
+ subroutine ext_iface(a, n)
+ integer, intent(in) :: n
+ real, intent(inout) :: a(n)
+ end subroutine
+ end interface
+ !$acc parallel loop gang
+ do k = 1, 10
+ call ext_iface(a, n)
+ end do
+end subroutine
More information about the flang-commits
mailing list