[flang] Use BaseBoxType in component by component assignment

[clementval]

Summary

Use BaseBoxType in genComponentByComponentAssignment
so the component by component assignment involving polymorphic entities
does not fall back to scalar assignment.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Optimizer/Builder/FIRBuilder.cpp

if (auto sequenceType = lFieldTy.dyn_cast<fir::SequenceType>()) {
       std::reverse(indices.begin(), indices.end());
       auto elementRefType = builder.getRefType(sequenceType.getEleTy());
       toCoor = builder.create<fir::CoordinateOp>(loc, elementRefType, toCoor,
                                                  indices);
       fromCoor = builder.create<fir::CoordinateOp>(loc, elementRefType,
                                                    fromCoor, indices);
     }
     if (auto fieldEleTy = fir::unwrapSequenceType(lFieldTy);
-        fieldEleTy.isa<fir::BoxType>()) {
-      assert(
-          fieldEleTy.cast<fir::BoxType>().getEleTy().isa<fir::PointerType>() &&
+        fieldEleTy.isa<fir::BaseBoxType>()) {
+      assert(fieldEleTy.cast<fir::BaseBoxType>()
+                 .getEleTy()
+                 .isa<fir::PointerType>() &&
              "allocatable members require deep copy");
       auto fromPointerValue = builder.create<fir::LoadOp>(loc, fromCoor);
       auto castTo = builder.createConvert(loc, fieldEleTy, fromPointerValue);
       builder.create<fir::StoreOp>(loc, castTo, toCoor);
     } else {
       auto from =
           fir::factory::componentToExtendedValue(builder, loc, fromCoor);
       auto to = fir::factory::componentToExtendedValue(builder, loc, toCoor);
       fir::factory::genScalarAssignment(builder, loc, to, from);
void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder,
                                        const fir::ExtendedValue &lhs,
                                        const fir::ExtendedValue &rhs) {
   assert(lhs.rank() == 0 && rhs.rank() == 0 && "assume scalar assignment");
   auto baseTy = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(lhs).getType());
   assert(baseTy && "must be a memory type");
   // Box operands may be polymorphic, it is not entirely clear from 10.2.1.3
   // if the assignment is performed on the dynamic of declared type. Use the
   // runtime assuming it is performed on the dynamic type.
-  bool hasBoxOperands = fir::getBase(lhs).getType().isa<fir::BoxType>() ||
-                        fir::getBase(rhs).getType().isa<fir::BoxType>();
+  bool hasBoxOperands = fir::getBase(lhs).getType().isa<fir::BaseBoxType>() ||
+                        fir::getBase(rhs).getType().isa<fir::BaseBoxType>();
   auto recTy = baseTy.dyn_cast<fir::RecordType>();
   assert(recTy && "must be a record type");
   if (hasBoxOperands || !recordTypeCanBeMemCopied(recTy)) {
     auto to = fir::getBase(builder.createBox(loc, lhs));
     auto from = fir::getBase(builder.createBox(loc, rhs));
     // The runtime entry point may modify the LHS descriptor if it is
     // an allocatable. Allocatable assignment is handle elsewhere in lowering,
     // so just create a fir.ref<fir.box<>> from the fir.box to comply with the

flang/test/Lower/polymorphic.f90

module polymorphic_test
   end type
 
   type c1
     character(2) :: tmp = 'c1'
   contains
     procedure :: get_tmp
   end type
 
+  type p3
+    class(p3), pointer :: p(:)
+  end type
+
   contains
 
   ! Test correct access to polymorphic entity component.
   subroutine component_access(p)
     class(p1) :: p
     print*, p%a
   end subroutine
 
! CHECK-LABEL: func.func @_QMpolymorphic_testPsub_with_type_array(%{{.*}}: !fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "a"})
   end subroutine
 
 ! CHECK-LABEL: func.func @_QMpolymorphic_testPcall_sub_with_type_array(
 ! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>> {fir.bindc_name = "p"}) {
 ! CHECK: %[[CLASS:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>>
 ! CHECK: %[[REBOX:.*]] = fir.rebox %[[CLASS]] : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>) -> !fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>
 ! CHECK: fir.call @_QMpolymorphic_testPsub_with_type_array(%[[REBOX]]) {{.*}} : (!fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> ()
 
+  subroutine derived_type_assignment_with_class()
+    type(p3) :: a
+    type(p3), target :: b(10)
+    a = p3(b)
+  end subroutine
+
 end module