[flang][hlfir] Lower allocatable assignment to HLFIR

Nothing much to do except set the right attributes on hlfir.assign.

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

diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index beac3b1..aafff14 100644 (file)
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -2807,18 +2807,32 @@ private:
               // [1] Plain old assignment.
               [&](const Fortran::evaluate::Assignment::Intrinsic &) {
                 Fortran::lower::StatementContext stmtCtx;
-                if (Fortran::lower::isWholeAllocatable(assign.lhs))
-                  TODO(loc, "HLFIR assignment to whole allocatable");
                 hlfir::Entity rhs = Fortran::lower::convertExprToHLFIR(
                     loc, *this, assign.rhs, localSymbols, stmtCtx);
-                // Dereference pointers and allocatables RHS: the target is
-                // being assigned from.
-                rhs = hlfir::derefPointersAndAllocatables(loc, builder, rhs);
+                // Load trivial scalar LHS to allow the loads to be hoisted
+                // outside of loops early if possible. This also dereferences
+                // pointer and allocatable RHS: the target is being assigned
+                // from.
+                rhs = hlfir::loadTrivialScalar(loc, builder, rhs);
                 hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR(
                     loc, *this, assign.lhs, localSymbols, stmtCtx);
-                // Dereference pointers LHS: the target is being assigned to.
-                lhs = hlfir::derefPointersAndAllocatables(loc, builder, lhs);
-                builder.create<hlfir::AssignOp>(loc, rhs, lhs);
+                bool isWholeAllocatableAssignment = false;
+                bool keepLhsLengthInAllocatableAssignment = false;
+                if (Fortran::lower::isWholeAllocatable(assign.lhs)) {
+                  isWholeAllocatableAssignment = true;
+                  if (std::optional<Fortran::evaluate::DynamicType> lhsType =
+                          assign.lhs.GetType())
+                    keepLhsLengthInAllocatableAssignment =
+                        lhsType->category() ==
+                            Fortran::common::TypeCategory::Character &&
+                        !lhsType->HasDeferredTypeParameter();
+                } else {
+                  // Dereference pointer LHS: the target is being assigned to.
+                  lhs = hlfir::derefPointersAndAllocatables(loc, builder, lhs);
+                }
+                builder.create<hlfir::AssignOp>(
+                    loc, rhs, lhs, isWholeAllocatableAssignment,
+                    keepLhsLengthInAllocatableAssignment);
               },
               // [2] User defined assignment. If the context is a scalar
               // expression then call the procedure.

diff --git a/flang/test/Lower/HLFIR/assignment-intrinsics.f90 b/flang/test/Lower/HLFIR/assignment-intrinsics.f90
index c3af0df..78b7083 100644 (file)
--- a/flang/test/Lower/HLFIR/assignment-intrinsics.f90
+++ b/flang/test/Lower/HLFIR/assignment-intrinsics.f90
@@ -12,7 +12,8 @@ end subroutine
 ! CHECK-LABEL: func.func @_QPscalar_int(
 ! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare {{.*}}  {uniq_name = "_QFscalar_intEx"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
 ! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}  {uniq_name = "_QFscalar_intEy"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
-! CHECK:  hlfir.assign %[[VAL_3]]#0 to %[[VAL_2]]#0 : !fir.ref<i32>, !fir.ref<i32>
+! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0
+! CHECK:  hlfir.assign %[[VAL_4]] to %[[VAL_2]]#0 : i32, !fir.ref<i32>
 
 subroutine scalar_logical(x, y)
   logical :: x, y
@@ -21,7 +22,8 @@ end subroutine
 ! CHECK-LABEL: func.func @_QPscalar_logical(
 ! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare {{.*}}  {uniq_name = "_QFscalar_logicalEx"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)
 ! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}  {uniq_name = "_QFscalar_logicalEy"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)
-! CHECK:  hlfir.assign %[[VAL_3]]#0 to %[[VAL_2]]#0 : !fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>
+! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0
+! CHECK:  hlfir.assign %[[VAL_4]] to %[[VAL_2]]#0 : !fir.logical<4>, !fir.ref<!fir.logical<4>>
 
 subroutine scalar_real(x, y)
   real :: x, y
@@ -30,7 +32,8 @@ end subroutine
 ! CHECK-LABEL: func.func @_QPscalar_real(
 ! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare {{.*}}  {uniq_name = "_QFscalar_realEx"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
 ! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}  {uniq_name = "_QFscalar_realEy"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
-! CHECK:  hlfir.assign %[[VAL_3]]#0 to %[[VAL_2]]#0 : !fir.ref<f32>, !fir.ref<f32>
+! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0
+! CHECK:  hlfir.assign %[[VAL_4]] to %[[VAL_2]]#0 : f32, !fir.ref<f32>
 
 subroutine scalar_complex(x, y)
   complex :: x, y
@@ -39,7 +42,8 @@ end subroutine
 ! CHECK-LABEL: func.func @_QPscalar_complex(
 ! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare {{.*}}  {uniq_name = "_QFscalar_complexEx"} : (!fir.ref<!fir.complex<4>>) -> (!fir.ref<!fir.complex<4>>, !fir.ref<!fir.complex<4>>)
 ! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}  {uniq_name = "_QFscalar_complexEy"} : (!fir.ref<!fir.complex<4>>) -> (!fir.ref<!fir.complex<4>>, !fir.ref<!fir.complex<4>>)
-! CHECK:  hlfir.assign %[[VAL_3]]#0 to %[[VAL_2]]#0 : !fir.ref<!fir.complex<4>>, !fir.ref<!fir.complex<4>>
+! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0
+! CHECK:  hlfir.assign %[[VAL_4]] to %[[VAL_2]]#0 : !fir.complex<4>, !fir.ref<!fir.complex<4>>
 
 subroutine scalar_character(x, y)
   character(*) :: x, y
@@ -157,4 +161,39 @@ end subroutine
 ! CHECK-LABEL: func.func @_QParray_scalar(
 ! CHECK:  %[[VAL_4:.*]]:2 = hlfir.declare {{.*}}  {uniq_name = "_QFarray_scalarEx"} : (!fir.ref<!fir.array<100xi32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<100xi32>>, !fir.ref<!fir.array<100xi32>>)
 ! CHECK:  %[[VAL_5:.*]]:2 = hlfir.declare {{.*}}  {uniq_name = "_QFarray_scalarEy"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
-! CHECK:  hlfir.assign %[[VAL_5]]#0 to %[[VAL_4]]#0 : !fir.ref<i32>, !fir.ref<!fir.array<100xi32>>
+! CHECK:  %[[VAL_6:.*]] = fir.load %[[VAL_5]]#0
+! CHECK:  hlfir.assign %[[VAL_6]] to %[[VAL_4]]#0 : i32, !fir.ref<!fir.array<100xi32>>
+
+! -----------------------------------------------------------------------------
+!     Test assignments with whole allocatable LHS
+! -----------------------------------------------------------------------------
+
+subroutine test_whole_allocatable_assignment(x, y)
+  integer, allocatable :: x(:)
+  integer :: y(:)
+  x = y
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_whole_allocatable_assignment(
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare {{.*}}Ex"
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}Ey"
+! CHECK:  hlfir.assign %[[VAL_3]]#0 to %[[VAL_2]]#0 realloc : !fir.box<!fir.array<?xi32>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+
+subroutine test_whole_allocatable_deferred_char(x, y)
+  character(:), allocatable :: x
+  character(*) :: y
+  x = y
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_whole_allocatable_deferred_char(
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare {{.*}}Ex"
+! CHECK:  %[[VAL_4:.*]]:2 = hlfir.declare {{.*}}Ey"
+! CHECK:  hlfir.assign %[[VAL_4]]#0 to %[[VAL_2]]#0 realloc : !fir.boxchar<1>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+
+subroutine test_whole_allocatable_assumed_char(x, y)
+  character(*), allocatable :: x
+  character(*) :: y
+  x = y
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_whole_allocatable_assumed_char(
+! CHECK:  %[[VAL_4:.*]]:2 = hlfir.declare {{.*}}Ex"
+! CHECK:  %[[VAL_6:.*]]:2 = hlfir.declare {{.*}}Ey"
+! CHECK:  hlfir.assign %[[VAL_6]]#0 to %[[VAL_4]]#0 realloc keep_lhs_len : !fir.boxchar<1>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>