From 773d7d8f71d6991ae93c0cd280304df62a3bd99d Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval@gmail.com>
Date: Mon, 6 Nov 2023 14:31:11 -0800
Subject: [PATCH] [flang][openacc] Correctly lower acc routine in interface
 block

---
 flang/lib/Lower/OpenACC.cpp                | 17 ++++++++--
 flang/test/Lower/OpenACC/acc-routine03.f90 | 36 ++++++++++++++++++++++
 2 files changed, 51 insertions(+), 2 deletions(-)
 create mode 100644 flang/test/Lower/OpenACC/acc-routine03.f90

diff --git a/flang/lib/Lower/OpenACC.cpp b/flang/lib/Lower/OpenACC.cpp
index 809fd3b3be7cf..bc90dc2ab7245 100644
--- a/flang/lib/Lower/OpenACC.cpp
+++ b/flang/lib/Lower/OpenACC.cpp
@@ -3201,8 +3201,21 @@ void Fortran::lower::genOpenACCRoutineConstruct(
     funcName = converter.mangleName(*name->symbol);
     funcOp = builder.getNamedFunction(mod, funcName);
   } else {
-    funcOp = builder.getFunction();
-    funcName = funcOp.getName();
+    Fortran::semantics::Scope &scope =
+        semanticsContext.FindScope(routineConstruct.source);
+    const Fortran::semantics::Scope &progUnit{GetProgramUnitContaining(scope)};
+    const auto *subpDetails{
+        progUnit.symbol()
+            ? progUnit.symbol()
+                  ->detailsIf<Fortran::semantics::SubprogramDetails>()
+            : nullptr};
+    if (subpDetails && subpDetails->isInterface()) {
+      funcName = converter.mangleName(*progUnit.symbol());
+      funcOp = builder.getNamedFunction(mod, funcName);
+    } else {
+      funcOp = builder.getFunction();
+      funcName = funcOp.getName();
+    }
   }
   bool hasSeq = false, hasGang = false, hasWorker = false, hasVector = false,
        hasNohost = false;
diff --git a/flang/test/Lower/OpenACC/acc-routine03.f90 b/flang/test/Lower/OpenACC/acc-routine03.f90
new file mode 100644
index 0000000000000..9b64482e312a2
--- /dev/null
+++ b/flang/test/Lower/OpenACC/acc-routine03.f90
@@ -0,0 +1,36 @@
+! This test checks lowering of OpenACC routine directive in interfaces.
+
+! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s
+! RUN: bbc -fopenacc -emit-hlfir %s -o - | FileCheck %s
+
+
+subroutine sub1(a)
+  !$acc routine worker bind(sub2)
+  real :: a(:)
+end subroutine
+
+subroutine sub2(a)
+  !$acc routine worker nohost
+  real :: a(:)
+end subroutine
+
+subroutine test
+
+interface
+  subroutine sub1(a)
+    !$acc routine worker bind(sub2)
+    real :: a(:)
+  end subroutine
+ 
+  subroutine sub2(a)
+    !$acc routine worker nohost
+    real :: a(:)
+  end subroutine
+end interface
+
+end subroutine
+
+! CHECK: acc.routine @acc_routine_1 func(@_QPsub2) worker nohost
+! CHECK: acc.routine @acc_routine_0 func(@_QPsub1) bind("_QPsub2") worker
+! CHECK: func.func @_QPsub1(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "a"}) attributes {acc.routine_info = #acc.routine_info<[@acc_routine_0]>}
+! CHECK: func.func @_QPsub2(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "a"}) attributes {acc.routine_info = #acc.routine_info<[@acc_routine_1]>}