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

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-fir-hlfir

@llvm/pr-subscribers-flang-semantics

Author: khaki3

<details>
<summary>Changes</summary>

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.


---
Full diff: https://github.com/llvm/llvm-project/pull/192367.diff


4 Files Affected:

- (modified) flang/include/flang/Semantics/symbol.h (+7) 
- (modified) flang/lib/Lower/CallInterface.cpp (+12-5) 
- (modified) flang/lib/Semantics/resolve-directives.cpp (+7-2) 
- (added) flang/test/Lower/OpenACC/acc-routine-named-external.f90 (+52) 


``````````diff
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..1aad33e998af9 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -718,12 +718,19 @@ 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

``````````

</details>


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