diff --git a/flang/lib/Lower/OpenACC.cpp b/flang/lib/Lower/OpenACC.cpp --- a/flang/lib/Lower/OpenACC.cpp +++ b/flang/lib/Lower/OpenACC.cpp @@ -2905,8 +2905,25 @@ llvm_unreachable("unsupported declarative directive"); } +template +std::optional +GetConstExpr(Fortran::semantics::SemanticsContext &semanticsContext, + const T &x) { + using DefaultCharConstantType = Fortran::evaluate::Ascii; + if (const auto *expr{Fortran::semantics::GetExpr(semanticsContext, x)}) { + const auto foldExpr{Fortran::evaluate::Fold( + semanticsContext.foldingContext(), Fortran::common::Clone(*expr))}; + if constexpr (std::is_same_v) { + return Fortran::evaluate::GetScalarConstantValue( + foldExpr); + } + } + return std::nullopt; +} + static void genACC(Fortran::lower::AbstractConverter &converter, + Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenACCRoutineConstruct &routineConstruct) { fir::FirOpBuilder &builder = converter.getFirOpBuilder(); @@ -2955,6 +2972,21 @@ routineOp.setWorkerAttr(builder.getUnitAttr()); } else if (std::get_if(&clause.u)) { routineOp.setNohostAttr(builder.getUnitAttr()); + } else if (const auto *bindClause = + std::get_if(&clause.u)) { + if (const auto *name = + std::get_if(&bindClause->v.u)) { + routineOp.setBindName( + builder.getStringAttr(converter.mangleName(*name->symbol))); + } else if (const auto charExpr = + std::get_if( + &bindClause->v.u)) { + const std::optional bindName = + GetConstExpr(semanticsContext, *charExpr); + if (!bindName) + routineOp.emitError("Could not retrieve the bind name"); + routineOp.setBindName(builder.getStringAttr(*bindName)); + } } } @@ -3025,7 +3057,7 @@ }, [&](const Fortran::parser::OpenACCRoutineConstruct &routineConstruct) { - genACC(converter, eval, routineConstruct); + genACC(converter, semanticsContext, eval, routineConstruct); }, }, accDeclConstruct.u); diff --git a/flang/test/Lower/OpenACC/acc-routine.f90 b/flang/test/Lower/OpenACC/acc-routine.f90 --- a/flang/test/Lower/OpenACC/acc-routine.f90 +++ b/flang/test/Lower/OpenACC/acc-routine.f90 @@ -2,6 +2,8 @@ ! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s +! CHECK: acc.routine @acc_routine_8 func(@_QPacc_routine9) bind("_QPacc_routine9a") +! CHECK: acc.routine @acc_routine_7 func(@_QPacc_routine8) bind("routine8_") ! CHECK: acc.routine @acc_routine_6 func(@_QPacc_routine7) gang(dim = 1 : i32) ! CHECK: acc.routine @acc_routine_5 func(@_QPacc_routine6) nohost ! CHECK: acc.routine @acc_routine_4 func(@_QPacc_routine5) worker @@ -51,3 +53,18 @@ end subroutine ! CHECK-LABEL: func.func @_QPacc_routine7() attributes {acc.routine_info = #acc.routine_info<[@acc_routine_6]>} + +subroutine acc_routine8() + !$acc routine bind("routine8_") +end subroutine + +! CHECK-LABEL: func.func @_QPacc_routine8() attributes {acc.routine_info = #acc.routine_info<[@acc_routine_7]>} + +subroutine acc_routine9a() +end subroutine + +subroutine acc_routine9() + !$acc routine bind(acc_routine9a) +end subroutine + +! CHECK-LABEL: func.func @_QPacc_routine9() attributes {acc.routine_info = #acc.routine_info<[@acc_routine_8]>}