[flang][hlfir] Lower associate construct to HLFIR

- 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.

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

diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index aafff14..b690ad3 100644 (file)
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -2093,6 +2093,8 @@ private:
   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)

diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp
index f1f1cc0..a154b91 100644 (file)
--- a/flang/lib/Lower/Mangler.cpp
+++ b/flang/lib/Lower/Mangler.cpp
@@ -41,12 +41,20 @@ moduleNames(const Fortran::semantics::Symbol &symbol) {
 
 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
@@ -80,6 +88,15 @@ Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &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 &) {
@@ -117,13 +134,10 @@ Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
                                                  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 =

diff --git a/flang/test/Lower/HLFIR/associate-construct.f90 b/flang/test/Lower/HLFIR/associate-construct.f90
new file mode 100644 (file)
index 0000000..c9f7f2f
--- /dev/null
+++ b/flang/test/Lower/HLFIR/associate-construct.f90
@@ -0,0 +1,97 @@
+! 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