[flang-commits] [flang] edfaae8 - [flang][openacc] Correctly lower acc routine in interface block (#71451)

[via flang-commits]

Author: Valentin Clement (バレンタイン クレメン)
Date: 2023-11-06T17:48:45-08:00
New Revision: edfaae87264c60f821432fb6e2eeb21e8c5de414

URL: https://github.com/llvm/llvm-project/commit/edfaae87264c60f821432fb6e2eeb21e8c5de414
DIFF: https://github.com/llvm/llvm-project/commit/edfaae87264c60f821432fb6e2eeb21e8c5de414.diff

LOG: [flang][openacc] Correctly lower acc routine in interface block (#71451)

When the acc routine directive was in an interface block in a
subroutine, the routine information was attached to the wrong
subroutine. This patch fixes this be retrieving the subroutine name in
the interface.

Added: 
    flang/test/Lower/OpenACC/acc-routine03.f90

Modified: 
    flang/lib/Lower/OpenACC.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/OpenACC.cpp b/flang/lib/Lower/OpenACC.cpp
index 2337beb80dc979d..1c045b4273e2607 100644
--- a/flang/lib/Lower/OpenACC.cpp
+++ b/flang/lib/Lower/OpenACC.cpp
@@ -3224,8 +3224,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 000000000000000..9b64482e312a2d3
--- /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]>}