Skip to content

Commit edfaae8

Browse files
authored
[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.
1 parent 5d3d084 commit edfaae8

File tree

2 files changed

+51
-2
lines changed

2 files changed

+51
-2
lines changed

flang/lib/Lower/OpenACC.cpp

+15-2
Original file line numberDiff line numberDiff line change
@@ -3224,8 +3224,21 @@ void Fortran::lower::genOpenACCRoutineConstruct(
32243224
funcName = converter.mangleName(*name->symbol);
32253225
funcOp = builder.getNamedFunction(mod, funcName);
32263226
} else {
3227-
funcOp = builder.getFunction();
3228-
funcName = funcOp.getName();
3227+
Fortran::semantics::Scope &scope =
3228+
semanticsContext.FindScope(routineConstruct.source);
3229+
const Fortran::semantics::Scope &progUnit{GetProgramUnitContaining(scope)};
3230+
const auto *subpDetails{
3231+
progUnit.symbol()
3232+
? progUnit.symbol()
3233+
->detailsIf<Fortran::semantics::SubprogramDetails>()
3234+
: nullptr};
3235+
if (subpDetails && subpDetails->isInterface()) {
3236+
funcName = converter.mangleName(*progUnit.symbol());
3237+
funcOp = builder.getNamedFunction(mod, funcName);
3238+
} else {
3239+
funcOp = builder.getFunction();
3240+
funcName = funcOp.getName();
3241+
}
32293242
}
32303243
bool hasSeq = false, hasGang = false, hasWorker = false, hasVector = false,
32313244
hasNohost = false;
+36
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
! This test checks lowering of OpenACC routine directive in interfaces.
2+
3+
! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s
4+
! RUN: bbc -fopenacc -emit-hlfir %s -o - | FileCheck %s
5+
6+
7+
subroutine sub1(a)
8+
!$acc routine worker bind(sub2)
9+
real :: a(:)
10+
end subroutine
11+
12+
subroutine sub2(a)
13+
!$acc routine worker nohost
14+
real :: a(:)
15+
end subroutine
16+
17+
subroutine test
18+
19+
interface
20+
subroutine sub1(a)
21+
!$acc routine worker bind(sub2)
22+
real :: a(:)
23+
end subroutine
24+
25+
subroutine sub2(a)
26+
!$acc routine worker nohost
27+
real :: a(:)
28+
end subroutine
29+
end interface
30+
31+
end subroutine
32+
33+
! CHECK: acc.routine @acc_routine_1 func(@_QPsub2) worker nohost
34+
! CHECK: acc.routine @acc_routine_0 func(@_QPsub1) bind("_QPsub2") worker
35+
! CHECK: func.func @_QPsub1(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "a"}) attributes {acc.routine_info = #acc.routine_info<[@acc_routine_0]>}
36+
! CHECK: func.func @_QPsub2(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "a"}) attributes {acc.routine_info = #acc.routine_info<[@acc_routine_1]>}

0 commit comments

Comments
 (0)