[flang][hlfir] deref pointers before lowering assignment to hlfir.assign

[jeanPerier]

Summary

There is little point not to dereference pointers LHS and RHS before
before emitting an hlfir.assign when lowering an assignment.
This pushes complexity and descriptor read side effects that are better
expressed in a load before the assignment.

[clementval]

LGTM

flang/lib/Lower/Bridge.cpp

if (lowerToHighLevelFIR()) {
       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::EntityWithAttributes rhs =
-                    Fortran::lower::convertExprToHLFIR(loc, *this, assign.rhs,
-                                                       localSymbols, stmtCtx);
-                hlfir::EntityWithAttributes lhs =
-                    Fortran::lower::convertExprToHLFIR(loc, *this, assign.lhs,
-                                                       localSymbols, stmtCtx);
+                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);
+                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);
               },
               // [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) {

flang/lib/Optimizer/Builder/HLFIRTools.cpp

 }
 
 hlfir::Entity hlfir::derefPointersAndAllocatables(mlir::Location loc,
                                                   fir::FirOpBuilder &builder,
                                                   Entity entity) {
   if (entity.isMutableBox()) {
     hlfir::Entity boxLoad{builder.create<fir::LoadOp>(loc, entity)};
     if (entity.isScalar()) {
-      mlir::Type elementType = boxLoad.getFortranElementType();
-      if (fir::isa_trivial(elementType))
+      if (!entity.isPolymorphic() && !entity.hasLengthParameters())
         return hlfir::Entity{builder.create<fir::BoxAddrOp>(loc, boxLoad)};
+      mlir::Type elementType = boxLoad.getFortranElementType();
       if (auto charType = elementType.dyn_cast<fir::CharacterType>()) {
         mlir::Value base = builder.create<fir::BoxAddrOp>(loc, boxLoad);
         if (charType.hasConstantLen())
           return hlfir::Entity{base};
         mlir::Value len = genCharacterVariableLength(loc, builder, entity);
         auto boxCharType =
             fir::BoxCharType::get(builder.getContext(), charType.getFKind());
         return hlfir::Entity{
             builder.create<fir::EmboxCharOp>(loc, boxCharType, base, len)
                 .getResult()};
       }
     }
-    // Keep the entity boxed for now.
+    // Otherwise, the entity is either an array, a polymorphic entity, or a
+    // derived type with length parameters. All these entities require a fir.box
+    // or fir.class to hold bounds, dynamic type or length parameter
+    // information. Keep them boxed.
     return boxLoad;
   }
   return entity;
 }
 
 mlir::Type hlfir::getVariableElementType(hlfir::Entity variable) {
   assert(variable.isVariable() && "entity must be a variable");
   if (variable.isScalar())

flang/test/Lower/HLFIR/allocatable-and-pointer-subparts.f90

subroutine test_pointer_component_followed_by_component_ref(x)
   use m
   type(t2) :: x
   call takes_real(x%p%x)
 end subroutine
 ! CHECK-LABEL: func.func @_QPtest_pointer_component_followed_by_component_ref(
 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %{{.*}} {{.*}}Ex
 ! CHECK:  %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"p"}   {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMmTt2{p:!fir.box<!fir.ptr<!fir.type<_QMmTt1{x:f32}>>>}>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.type<_QMmTt1{x:f32}>>>>
 ! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QMmTt1{x:f32}>>>>
-! CHECK:  %[[VAL_4:.*]] = hlfir.designate %[[VAL_3]]{"x"}   : (!fir.box<!fir.ptr<!fir.type<_QMmTt1{x:f32}>>>) -> !fir.ref<f32>
+! CHECK:  %[[VAL_4:.*]] = fir.box_addr %[[VAL_3:.*]] : (!fir.box<!fir.ptr<!fir.type<_QMmTt1{x:f32}>>>) -> !fir.ptr<!fir.type<_QMmTt1{x:f32}>>
+! CHECK:  hlfir.designate %[[VAL_4]]{"x"}   : (!fir.ptr<!fir.type<_QMmTt1{x:f32}>>) -> !fir.ref<f32>
 
 subroutine test_symbol_followed_by_ref(x)
   character(:), allocatable :: x(:)
   call test_char(x(10))
 end subroutine
 ! CHECK-LABEL: func.func @_QPtest_symbol_followed_by_ref(
 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %{{.*}} {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = {{.*}}Ex"
 ! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>

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

subroutine array_character(x, y)
   character(*) :: x(10), y(10)
   x = y
 end subroutine
 ! CHECK-LABEL: func.func @_QParray_character(
 ! CHECK:  %[[VAL_6:.*]]:2 = hlfir.declare {{.*}}  {uniq_name = "_QFarray_characterEx"} : (!fir.ref<!fir.array<10x!fir.char<1,?>>>, !fir.shape<1>, index) -> (!fir.box<!fir.array<10x!fir.char<1,?>>>, !fir.ref<!fir.array<10x!fir.char<1,?>>>)
 ! CHECK:  %[[VAL_11:.*]]:2 = hlfir.declare {{.*}}  {uniq_name = "_QFarray_characterEy"} : (!fir.ref<!fir.array<10x!fir.char<1,?>>>, !fir.shape<1>, index) -> (!fir.box<!fir.array<10x!fir.char<1,?>>>, !fir.ref<!fir.array<10x!fir.char<1,?>>>)
 ! CHECK:  hlfir.assign %[[VAL_11]]#0 to %[[VAL_6]]#0 : !fir.box<!fir.array<10x!fir.char<1,?>>>, !fir.box<!fir.array<10x!fir.char<1,?>>>
 
+subroutine array_pointer(x, y)
+  real, pointer :: x(:), y(:)
+  x = y
+end subroutine
+! CHECK-LABEL: func.func @_QParray_pointer(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %{{.*}}Ex
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %{{.*}}Ey
+! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK:  hlfir.assign %[[VAL_3]] to %[[VAL_4]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.box<!fir.ptr<!fir.array<?xf32>>>
+
 ! -----------------------------------------------------------------------------
 !     Test assignments with array LHS and scalar RHS
 ! -----------------------------------------------------------------------------
 
 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>>