[flang][openacc] Lower the bind clause on acc routine

Lower the bind clause to the corresponding attribute

Depends on D158120

Reviewed By: razvanlupusoru

Differential Revision: https://reviews.llvm.org/D158121

Author: clementval

flang/lib/Lower/OpenACC.cpp

@@ -2905,8 +2905,25 @@ static void genACC(Fortran::lower::AbstractConverter &converter,
   llvm_unreachable("unsupported declarative directive");
 }
 
+template <typename R, typename T>
+std::optional<R>
+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<R, std::string>) {
+      return Fortran::evaluate::GetScalarConstantValue<DefaultCharConstantType>(
+          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 @@ genACC(Fortran::lower::AbstractConverter &converter,
       routineOp.setWorkerAttr(builder.getUnitAttr());
     } else if (std::get_if<Fortran::parser::AccClause::Nohost>(&clause.u)) {
       routineOp.setNohostAttr(builder.getUnitAttr());
+    } else if (const auto *bindClause =
+                   std::get_if<Fortran::parser::AccClause::Bind>(&clause.u)) {
+      if (const auto *name =
+              std::get_if<Fortran::parser::Name>(&bindClause->v.u)) {
+        routineOp.setBindName(
+            builder.getStringAttr(converter.mangleName(*name->symbol)));
+      } else if (const auto charExpr =
+                     std::get_if<Fortran::parser::ScalarDefaultCharExpr>(
+                         &bindClause->v.u)) {
+        const std::optional<std::string> bindName =
+            GetConstExpr<std::string>(semanticsContext, *charExpr);
+        if (!bindName)
+          routineOp.emitError("Could not retrieve the bind name");
+        routineOp.setBindName(builder.getStringAttr(*bindName));
+      }
     }
   }
 
@@ -3025,7 +3057,7 @@ void Fortran::lower::genOpenACCDeclarativeConstruct(
           },
           [&](const Fortran::parser::OpenACCRoutineConstruct
                   &routineConstruct) {
-            genACC(converter, eval, routineConstruct);
+            genACC(converter, semanticsContext, eval, routineConstruct);
           },
       },
       accDeclConstruct.u);

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 @@ subroutine acc_routine7()
 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]>}