[flang][hlfir] Lower allocatable assignment to HLFIR

[jeanPerier]

Summary

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

Depends on D144723.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Lower/Bridge.cpp

if (lowerToHighLevelFIR()) {
       if (explicitIterationSpace() || !implicitIterSpace.empty())
         TODO(loc, "HLFIR assignment inside FORALL or WHERE");
       auto &builder = getFirOpBuilder();
       std::visit(
           Fortran::common::visitors{
               // [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.
+                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);
+                }
+                builder.create<hlfir::AssignOp>(
+                    loc, rhs, lhs, isWholeAllocatableAssignment,
+                    keepLhsLengthInAllocatableAssignment);
               },
               // [2] User defined assignment. If the context is a scalar
               // expression then call the procedure.
               [&](const Fortran::evaluate::ProcedureRef &procRef) {
                 TODO(loc, "HLFIR user defined assignment");
               },
               [&](const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
                 genPointerAssignment(loc, assign, lbExprs);

flang/test/Lower/HLFIR/assignment-intrinsics.f90

 ! Test lowering of intrinsic assignments to HLFIR
 ! RUN: bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s
 
 ! -----------------------------------------------------------------------------
 !     Test assignments with scalar variable LHS and RHS
 ! -----------------------------------------------------------------------------
 
 subroutine scalar_int(x, y)
   integer :: x, y
   x = y
 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
   x = y
 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
   x = y
 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
   x = y
 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
   x = y
 end subroutine
 ! CHECK-LABEL: func.func @_QPscalar_character(
 ! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}  {uniq_name = "_QFscalar_characterEx"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
 ! CHECK:  %[[VAL_5:.*]]:2 = hlfir.declare {{.*}}  {uniq_name = "_QFscalar_characterEy"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)

 
 subroutine array_scalar(x, y)
   integer :: x(100), y
   x = y
 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,?>>>>