[flang-commits] [flang] 2b8311e - [flang][OpenACC] Support acc routine info on ProcEntityDetails for separate compilation (#192367)
via flang-commits
flang-commits at lists.llvm.org
Fri Apr 17 10:56:13 PDT 2026
Author: khaki3
Date: 2026-04-17T10:56:07-07:00
New Revision: 2b8311ef3e6484679370d60b369aa189f48981b9
URL: https://github.com/llvm/llvm-project/commit/2b8311ef3e6484679370d60b369aa189f48981b9
DIFF: https://github.com/llvm/llvm-project/commit/2b8311ef3e6484679370d60b369aa189f48981b9.diff
LOG: [flang][OpenACC] Support acc routine info on ProcEntityDetails for separate compilation (#192367)
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.
Added:
flang/test/Lower/OpenACC/acc-routine-named-external.f90
Modified:
flang/include/flang/Semantics/symbol.h
flang/lib/Lower/CallInterface.cpp
flang/lib/Semantics/resolve-directives.cpp
Removed:
################################################################################
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 6b42a7290e260..b97f7ce58a1c0 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -1404,84 +1404,85 @@ 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