[flang-commits] [flang] [flang][OpenACC] Support acc routine info on ProcEntityDetails for separate compilation (PR #192367)

[via flang-commits]

https://github.com/khaki3 updated https://github.com/llvm/llvm-project/pull/192367

>From b8bba12d0ed7be77f923703f2b1afc0880277aff Mon Sep 17 00:00:00 2001
From: Kazuaki Matsumura <kmatsumura at nvidia.com>
Date: Wed, 15 Apr 2026 17:31:11 -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    |  9 +++-
 .../OpenACC/acc-routine-named-external.f90    | 52 +++++++++++++++++++
 4 files changed, 77 insertions(+), 7 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..f70a9445e1972 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -1405,7 +1405,9 @@ MaybeExpr EvaluateExpr(
 
 void AccAttributeVisitor::AddRoutineInfoToSymbol(
     Symbol &symbol, const parser::OpenACCRoutineConstruct &x) {
-  if (symbol.has<SubprogramDetails>()) {
+  if (!symbol.has<SubprogramDetails>() && !symbol.has<ProcEntityDetails>())
+    return;
+  {
     Fortran::semantics::OpenACCRoutineInfo info;
     std::vector<OpenACCRoutineDeviceTypeInfo *> currentDevices;
     currentDevices.push_back(&info);
@@ -1481,7 +1483,10 @@ void AccAttributeVisitor::AddRoutineInfoToSymbol(
         }
       }
     }
-    symbol.get<SubprogramDetails>().add_openACCRoutineInfo(info);
+    if (symbol.has<SubprogramDetails>())
+      symbol.get<SubprogramDetails>().add_openACCRoutineInfo(info);
+    else
+      symbol.get<ProcEntityDetails>().add_openACCRoutineInfo(info);
   }
 }
 
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..b3759ea7451d9
--- /dev/null
+++ b/flang/test/Lower/OpenACC/acc-routine-named-external.f90
@@ -0,0 +1,52 @@
+! 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