[flang] Handle parent component in select type

[clementval]

Summary

In select type construct the associating entity in a TYPE IS
type guard statement is obtained with a fir.convert. Update the code
for the parent component to support fir.convert defining op
as well.

[jeanPerier]

Looks good to me

flang/lib/Lower/ConvertExpr.cpp

 fir::ExtendedValue
 updateBoxForParentComponent(Fortran::lower::AbstractConverter &converter,
                             fir::ExtendedValue box,
                             const Fortran::lower::SomeExpr &expr) {
   mlir::Location loc = converter.getCurrentLocation();
   auto &builder = converter.getFirOpBuilder();
   mlir::Value boxBase = fir::getBase(box);
   mlir::Operation *op = boxBase.getDefiningOp();
-  fir::BoxType boxTy = boxBase.getType().dyn_cast<fir::BoxType>();
+  auto boxTy = boxBase.getType().dyn_cast<fir::BaseBoxType>();
   mlir::Type boxEleTy = fir::unwrapAllRefAndSeqType(boxTy.getEleTy());
   auto originalRecTy = boxEleTy.dyn_cast<fir::RecordType>();
   mlir::Type actualTy = converter.genType(expr);
   mlir::Type eleTy = fir::unwrapAllRefAndSeqType(actualTy);
   auto parentCompTy = eleTy.dyn_cast<fir::RecordType>();
   assert(parentCompTy && "expecting derived-type");
 
-  assert(
-      (mlir::dyn_cast<fir::EmboxOp>(op) || mlir::dyn_cast<fir::ReboxOp>(op)) &&
-      "expecting fir.embox or fir.rebox operation");
+  assert((mlir::dyn_cast<fir::EmboxOp>(op) ||
+          mlir::dyn_cast<fir::ReboxOp>(op) ||
+          mlir::dyn_cast<fir::ConvertOp>(op)) &&
+         "expecting fir.embox or fir.rebox or fir.convert operation");
 
   if (parentCompTy.getTypeList().empty())
     TODO(loc, "parent component with no component");
 
   // Creating a slice with a path to the first component of the parent component
   // of the extended type.
   auto firstComponent = parentCompTy.getTypeList().front();
   auto fieldTy = fir::FieldType::get(boxTy.getContext());
   auto field = builder.create<fir::FieldIndexOp>(
       loc, fieldTy, firstComponent.first, originalRecTy,
       /*typeParams=*/mlir::ValueRange{});
 
+  if (auto convert = mlir::dyn_cast<fir::ConvertOp>(op)) {
+    auto rebox = builder.create<fir::ReboxOp>(loc, fir::BoxType::get(actualTy),
+                                              convert.getValue(), mlir::Value{},
+                                              mlir::Value{});
+    return fir::substBase(box, fir::getBase(rebox));
+  }
   if (auto embox = mlir::dyn_cast<fir::EmboxOp>(op)) {
     mlir::Value slice = createSliceForParentComp(builder, loc, embox, box,
                                                  field, expr.Rank() > 0);
     auto newBox = builder.create<fir::EmboxOp>(
         loc, fir::BoxType::get(actualTy), embox.getMemref(), embox.getShape(),
         slice, embox.getTypeparams());
     return fir::substBase(box, fir::getBase(newBox));
   }

flang/test/Lower/polymorphic.f90

 ! CHECK-LABEL: func.func @_QMpolymorphic_testPmove_alloc_poly(
 ! CHECK-SAME: %[[A:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {fir.bindc_name = "a"}, %[[B:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {fir.bindc_name = "b"}) {
 ! CHECK: %[[TYPE_DESC:.*]] = fir.type_desc !fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>
 ! CHECK: %[[B_CONV:.*]] = fir.convert %[[B]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
 ! CHECK: %[[A_CONV:.*]] = fir.convert %[[A]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
 ! CHECK: %[[TYPE_DESC_CONV:.*]] = fir.convert %[[TYPE_DESC]] : (!fir.tdesc<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.ref<none>
 ! CHECK: %{{.*}} = fir.call @_FortranAMoveAlloc(%[[B_CONV]], %[[A_CONV]], %[[TYPE_DESC_CONV]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
 
+  subroutine test_parent_comp_in_select_type(s)
+    class(p1), allocatable :: s
+    class(p1), allocatable :: p
+
+    allocate(p1::p)
+
+    select type(s)
+      type is(p2)
+        s%p1 = p
+    end select
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_parent_comp_in_select_type(
+! CHECK-SAME: %[[S:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {fir.bindc_name = "s"}) {
+! CHECK:  %[[P:.*]] = fir.alloca !fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFtest_parent_comp_in_select_typeEp"}
+! CHECK:  %[[LOAD_S:.*]] = fir.load %[[S]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>
+! CHECK:  fir.select_type %[[LOAD_S]] : !fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> [#fir.type_is<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>, ^bb1, unit, ^bb2]
+! CHECK: ^bb1:
+! CHECK:  %[[REBOX_P1:.*]] = fir.rebox %[[LOAD_S]] : (!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK:  %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>
+! CHECK:  %[[LHS_CONV:.*]] = fir.convert %[[REBOX_P1]] : (!fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.ref<!fir.box<none>>
+! CHECK:  %[[RHS_CONV:.*]] = fir.convert %[[LOAD_P]] : (!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>
+! CHECK:  %{{.*}} = fir.call @_FortranAAssign(%[[LHS_CONV]], %[[RHS_CONV]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+
 end module
 
 program test
   use polymorphic_test
   type(outer), allocatable :: o
   integer :: i(5)
   logical :: l(5)
   allocate(o)