[flang][hlfir] Lower associate construct to HLFIR

[jeanPerier]

Summary

• always use genExprAddr when lowering to HLFIR: it does not create temporary for array sections without vector subscripts, so there is no need to have custom logic.

• update mangling to deal with AssocDetailsEntity. Their name is required in HLFIR so that it can be added to the hlfir.declare that is created for the selector once it is lowered. This should allow getting debug info for selector when debug info are generated from hlfir.declare.

The rest of associate construct lowering is unchanged and shared with
the current lowering.

This patch also enables select type lowering to work properly, but some
other todos (mainly about parent component references) prevents porting
the tests for now, so this will be done later.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Lower/Bridge.cpp

void genFIR(const Fortran::parser::SelectCaseStmt &stmt) {
     assert(caseValue == valueList.end() && caseBlock == blockList.end() &&
            "select case list mismatch");
     assert(stmtCtx.workListIsEmpty() && "statement context must be empty");
   }
 
   fir::ExtendedValue
   genAssociateSelector(const Fortran::lower::SomeExpr &selector,
                        Fortran::lower::StatementContext &stmtCtx) {
+    if (lowerToHighLevelFIR())
+      return genExprAddr(selector, stmtCtx);
     return Fortran::lower::isArraySectionWithoutVectorSubscript(selector)
                ? Fortran::lower::createSomeArrayBox(*this, selector,
                                                     localSymbols, stmtCtx)
                : genExprAddr(selector, stmtCtx);
   }
 
   void genFIR(const Fortran::parser::AssociateConstruct &) {
     Fortran::lower::StatementContext stmtCtx;

flang/lib/Lower/Mangler.cpp

moduleNames(const Fortran::semantics::Symbol &symbol) {
   const Fortran::semantics::Scope &scope = symbol.owner();
   llvm::SmallVector<llvm::StringRef> result;
   moduleNames(scope, result);
   return result;
 }
 
 static std::optional<llvm::StringRef>
 hostName(const Fortran::semantics::Symbol &symbol) {
-  const Fortran::semantics::Scope &scope = symbol.owner();
-  if (scope.kind() == Fortran::semantics::Scope::Kind::Subprogram) {
-    assert(scope.symbol() && "subprogram scope must have a symbol");
-    return toStringRef(scope.symbol()->name());
+  const Fortran::semantics::Scope *scope = &symbol.owner();
+  if (symbol.has<Fortran::semantics::AssocEntityDetails>())
+    // Associate/Select construct scopes are not part of the mangling. This can
+    // result in different construct selector being mangled with the same name.
+    // This is not an issue since these are not global symbols.
+    while (!scope->IsTopLevel() &&
+           (scope->kind() != Fortran::semantics::Scope::Kind::Subprogram &&
+            scope->kind() != Fortran::semantics::Scope::Kind::MainProgram))
+      scope = &scope->parent();
+  if (scope->kind() == Fortran::semantics::Scope::Kind::Subprogram) {
+    assert(scope->symbol() && "subprogram scope must have a symbol");
+    return toStringRef(scope->symbol()->name());
   }
-  if (scope.kind() == Fortran::semantics::Scope::Kind::MainProgram)
+  if (scope->kind() == Fortran::semantics::Scope::Kind::MainProgram)
     // Do not use the main program name, if any, because it may lead to name
     // collision with procedures with the same name in other compilation units
     // (technically illegal, but all compilers are able to compile and link
     // properly these programs).
     return llvm::StringRef("");
   return {};
 }
 
Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
   // interface (procedure(iface)), should be dealt within GetBindName()
   // directly, or some semantics wrapper.
   if (!Fortran::semantics::IsPointer(ultimateSymbol) &&
       Fortran::semantics::IsBindCProcedure(ultimateSymbol) &&
       Fortran::semantics::ClassifyProcedure(symbol) !=
           Fortran::semantics::ProcedureDefinitionClass::Internal)
     return ultimateSymbol.name().ToString();
 
+  // mangle ObjectEntityDetails or AssocEntityDetails symbols.
+  auto mangleObject = [&]() -> std::string {
+    llvm::SmallVector<llvm::StringRef> modNames = moduleNames(ultimateSymbol);
+    std::optional<llvm::StringRef> optHost = hostName(ultimateSymbol);
+    if (Fortran::semantics::IsNamedConstant(ultimateSymbol))
+      return fir::NameUniquer::doConstant(modNames, optHost, symbolName);
+    return fir::NameUniquer::doVariable(modNames, optHost, symbolName);
+  };
+
   return std::visit(
       Fortran::common::visitors{
           [&](const Fortran::semantics::MainProgramDetails &) {
             return fir::NameUniquer::doProgramEntry().str();
           },
           [&](const Fortran::semantics::SubprogramDetails &subpDetails) {
             // Mangle external procedure without any scope prefix.
             if (!keepExternalInScope &&
return std::visit(
                                                   symbolName);
             // Otherwise, this is an external procedure, even if it does not
             // have an explicit EXTERNAL attribute. Mangle it without any
             // prefix.
             return fir::NameUniquer::doProcedure(std::nullopt, std::nullopt,
                                                  symbolName);
           },
           [&](const Fortran::semantics::ObjectEntityDetails &) {
-            llvm::SmallVector<llvm::StringRef> modNames =
-                moduleNames(ultimateSymbol);
-            std::optional<llvm::StringRef> optHost = hostName(ultimateSymbol);
-            if (Fortran::semantics::IsNamedConstant(ultimateSymbol))
-              return fir::NameUniquer::doConstant(modNames, optHost,
-                                                  symbolName);
-            return fir::NameUniquer::doVariable(modNames, optHost, symbolName);
+            return mangleObject();
+          },
+          [&](const Fortran::semantics::AssocEntityDetails &) {
+            return mangleObject();
           },
           [&](const Fortran::semantics::NamelistDetails &) {
             llvm::SmallVector<llvm::StringRef> modNames =
                 moduleNames(ultimateSymbol);
             std::optional<llvm::StringRef> optHost = hostName(ultimateSymbol);
             return fir::NameUniquer::doNamelistGroup(modNames, optHost,
                                                      symbolName);
           },

flang/test/Lower/HLFIR/associate-construct.f90

+! Test lowering of associate construct to HLFIR
+! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s
+
+subroutine associate_expr(x)
+  integer :: x(:)
+  associate(y => x + 42)
+    print *, y
+  end associate
+end subroutine
+! CHECK-LABEL: func.func @_QPassociate_expr(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex"
+! CHECK:  %[[VAL_3:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_4:.*]]:3 = fir.box_dims %[[VAL_1]]#0, %[[VAL_3]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index)
+! CHECK:  %[[VAL_6:.*]] = hlfir.elemental {{.*}}
+! CHECK:  %[[VAL_11:.*]]:3 = hlfir.associate %[[VAL_6]]{{.*}}
+! CHECK:  %[[VAL_13:.*]] = fir.shape %[[VAL_4]]#1 : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_14:.*]]:2 = hlfir.declare %[[VAL_11]]#1(%[[VAL_13]]) {uniq_name = "_QFassociate_exprEy"} : (!fir.ref<!fir.array<?xi32>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.ref<!fir.array<?xi32>>)
+! CHECK:  fir.call @_FortranAioEndIoStatement
+! CHECK:  hlfir.end_associate %[[VAL_11]]#1, %[[VAL_11]]#2 : !fir.ref<!fir.array<?xi32>>, i1
+
+subroutine associate_var(x)
+  integer :: x
+  associate(y => x)
+    print *, y
+  end associate
+end subroutine
+! CHECK-LABEL: func.func @_QPassociate_var(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex"
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]]#1 {uniq_name = "_QFassociate_varEy"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK:  fir.call @_FortranAioEndIoStatement
+! CHECK-NEXT:  return
+
+subroutine associate_pointer(x)
+  integer, pointer, contiguous :: x(:)
+  ! Check that "y" has the target and contiguous attributes.
+  associate(y => x)
+    print *, y
+  end associate
+end subroutine
+! CHECK-LABEL: func.func @_QPassociate_pointer(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex"
+! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! CHECK:  %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xi32>>>) -> !fir.ptr<!fir.array<?xi32>>
+! CHECK:  %[[VAL_4:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?xi32>>>, index) -> (index, index, index)
+! CHECK:  %[[VAL_6:.*]] = fir.shape_shift %[[VAL_5]]#0, %[[VAL_5]]#1 : (index, index) -> !fir.shapeshift<1>
+! CHECK:  %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_6]]) {fortran_attrs = #fir.var_attrs<contiguous, target>, uniq_name = "_QFassociate_pointerEy"} : (!fir.ptr<!fir.array<?xi32>>, !fir.shapeshift<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.ptr<!fir.array<?xi32>>)
+! CHECK:  fir.call @_FortranAioEndIoStatement
+! CHECK-NEXT:  return
+
+subroutine associate_allocatable(x)
+  integer, allocatable :: x(:)
+  associate(y => x)
+    print *, y
+  end associate
+end subroutine
+! CHECK-LABEL: func.func @_QPassociate_allocatable(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex"
+! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK:  %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+! CHECK:  %[[VAL_4:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_4]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>, index) -> (index, index, index)
+! CHECK:  %[[VAL_6:.*]] = fir.shape_shift %[[VAL_5]]#0, %[[VAL_5]]#1 : (index, index) -> !fir.shapeshift<1>
+! CHECK:  %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_6]]) {uniq_name = "_QFassociate_allocatableEy"} : (!fir.heap<!fir.array<?xi32>>, !fir.shapeshift<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.heap<!fir.array<?xi32>>)
+! CHECK:  fir.call @_FortranAioEndIoStatement
+! CHECK-NEXT:  return
+
+subroutine associate_optional(x)
+  integer, optional :: x(:)
+  ! Check that "y" is not given the optional attribute: x must be present as per
+  ! Fortran 2018 11.1.3.2 point 4.
+  associate(y => x)
+    print *, y
+  end associate
+end subroutine
+! CHECK-LABEL: func.func @_QPassociate_optional(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex"
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]]#1 {uniq_name = "_QFassociate_optionalEy"} : (!fir.box<!fir.array<?xi32>>) -> (!fir.box<!fir.array<?xi32>>, !fir.box<!fir.array<?xi32>>)
+! CHECK:  fir.call @_FortranAioEndIoStatement
+! CHECK-NEXT:  return
+
+subroutine associate_pointer_section(x)
+  integer , pointer, contiguous :: x(:)
+  associate (y => x(1:20:1))
+    print *, y
+  end associate
+end subroutine
+! CHECK-LABEL: func.func @_QPassociate_pointer_section(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex"
+! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! CHECK:  %[[VAL_4:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_6:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_8:.*]] = hlfir.designate %[[VAL_2]]{{.*}}
+! CHECK:  %[[VAL_9:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_8]](%[[VAL_9]]) {fortran_attrs = #fir.var_attrs<contiguous, target>, uniq_name = "_QFassociate_pointer_sectionEy"} : (!fir.ref<!fir.array<20xi32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<20xi32>>, !fir.ref<!fir.array<20xi32>>)
+! CHECK:  fir.call @_FortranAioEndIoStatement
+! CHECK-NEXT:  return