diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -2807,18 +2807,32 @@ // [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(loc, rhs, lhs); + bool isWholeAllocatableAssignment = false; + bool keepLhsLengthInAllocatableAssignment = false; + if (Fortran::lower::isWholeAllocatable(assign.lhs)) { + isWholeAllocatableAssignment = true; + if (std::optional 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( + 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 --- a/flang/test/Lower/HLFIR/assignment-intrinsics.f90 +++ b/flang/test/Lower/HLFIR/assignment-intrinsics.f90 @@ -12,7 +12,8 @@ ! CHECK-LABEL: func.func @_QPscalar_int( ! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_intEx"} : (!fir.ref) -> (!fir.ref, !fir.ref) ! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_intEy"} : (!fir.ref) -> (!fir.ref, !fir.ref) -! CHECK: hlfir.assign %[[VAL_3]]#0 to %[[VAL_2]]#0 : !fir.ref, !fir.ref +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 +! CHECK: hlfir.assign %[[VAL_4]] to %[[VAL_2]]#0 : i32, !fir.ref subroutine scalar_logical(x, y) logical :: x, y @@ -21,7 +22,8 @@ ! CHECK-LABEL: func.func @_QPscalar_logical( ! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_logicalEx"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) ! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_logicalEy"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) -! CHECK: hlfir.assign %[[VAL_3]]#0 to %[[VAL_2]]#0 : !fir.ref>, !fir.ref> +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 +! CHECK: hlfir.assign %[[VAL_4]] to %[[VAL_2]]#0 : !fir.logical<4>, !fir.ref> subroutine scalar_real(x, y) real :: x, y @@ -30,7 +32,8 @@ ! CHECK-LABEL: func.func @_QPscalar_real( ! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_realEx"} : (!fir.ref) -> (!fir.ref, !fir.ref) ! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_realEy"} : (!fir.ref) -> (!fir.ref, !fir.ref) -! CHECK: hlfir.assign %[[VAL_3]]#0 to %[[VAL_2]]#0 : !fir.ref, !fir.ref +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 +! CHECK: hlfir.assign %[[VAL_4]] to %[[VAL_2]]#0 : f32, !fir.ref subroutine scalar_complex(x, y) complex :: x, y @@ -39,7 +42,8 @@ ! CHECK-LABEL: func.func @_QPscalar_complex( ! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_complexEx"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) ! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_complexEy"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) -! CHECK: hlfir.assign %[[VAL_3]]#0 to %[[VAL_2]]#0 : !fir.ref>, !fir.ref> +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 +! CHECK: hlfir.assign %[[VAL_4]] to %[[VAL_2]]#0 : !fir.complex<4>, !fir.ref> subroutine scalar_character(x, y) character(*) :: x, y @@ -157,4 +161,39 @@ ! CHECK-LABEL: func.func @_QParray_scalar( ! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFarray_scalarEx"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) ! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFarray_scalarEy"} : (!fir.ref) -> (!fir.ref, !fir.ref) -! CHECK: hlfir.assign %[[VAL_5]]#0 to %[[VAL_4]]#0 : !fir.ref, !fir.ref> +! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_5]]#0 +! CHECK: hlfir.assign %[[VAL_6]] to %[[VAL_4]]#0 : i32, !fir.ref> + +! ----------------------------------------------------------------------------- +! 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.ref>>> + +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>>> + +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>>>