diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -7236,7 +7236,7 @@ auto &builder = converter.getFirOpBuilder(); mlir::Value boxBase = fir::getBase(box); mlir::Operation *op = boxBase.getDefiningOp(); - fir::BoxType boxTy = boxBase.getType().dyn_cast(); + auto boxTy = boxBase.getType().dyn_cast(); mlir::Type boxEleTy = fir::unwrapAllRefAndSeqType(boxTy.getEleTy()); auto originalRecTy = boxEleTy.dyn_cast(); mlir::Type actualTy = converter.genType(expr); @@ -7244,9 +7244,10 @@ auto parentCompTy = eleTy.dyn_cast(); assert(parentCompTy && "expecting derived-type"); - assert( - (mlir::dyn_cast(op) || mlir::dyn_cast(op)) && - "expecting fir.embox or fir.rebox operation"); + assert((mlir::dyn_cast(op) || + mlir::dyn_cast(op) || + mlir::dyn_cast(op)) && + "expecting fir.embox or fir.rebox or fir.convert operation"); if (parentCompTy.getTypeList().empty()) TODO(loc, "parent component with no component"); @@ -7259,6 +7260,12 @@ loc, fieldTy, firstComponent.first, originalRecTy, /*typeParams=*/mlir::ValueRange{}); + if (auto convert = mlir::dyn_cast(op)) { + auto rebox = builder.create(loc, fir::BoxType::get(actualTy), + convert.getValue(), mlir::Value{}, + mlir::Value{}); + return fir::substBase(box, fir::getBase(rebox)); + } if (auto embox = mlir::dyn_cast(op)) { mlir::Value slice = createSliceForParentComp(builder, loc, embox, box, field, expr.Rank() > 0); diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90 --- a/flang/test/Lower/polymorphic.f90 +++ b/flang/test/Lower/polymorphic.f90 @@ -1001,6 +1001,30 @@ ! CHECK: %[[TYPE_DESC_CONV:.*]] = fir.convert %[[TYPE_DESC]] : (!fir.tdesc>) -> !fir.ref ! CHECK: %{{.*}} = fir.call @_FortranAMoveAlloc(%[[B_CONV]], %[[A_CONV]], %[[TYPE_DESC_CONV]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref>, !fir.ref>, !fir.ref, i1, !fir.box, !fir.ref, 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.bindc_name = "s"}) { +! CHECK: %[[P:.*]] = fir.alloca !fir.class>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFtest_parent_comp_in_select_typeEp"} +! CHECK: %[[LOAD_S:.*]] = fir.load %[[S]] : !fir.ref>>> +! CHECK: fir.select_type %[[LOAD_S]] : !fir.class>> [#fir.type_is>, ^bb1, unit, ^bb2] +! CHECK: ^bb1: +! CHECK: %[[REBOX_P1:.*]] = fir.rebox %[[LOAD_S]] : (!fir.class>>) -> !fir.box> +! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref>>> +! CHECK: %[[LHS_CONV:.*]] = fir.convert %[[REBOX_P1]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[RHS_CONV:.*]] = fir.convert %[[LOAD_P]] : (!fir.class>>) -> !fir.box +! CHECK: %{{.*}} = fir.call @_FortranAAssign(%[[LHS_CONV]], %[[RHS_CONV]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref>, !fir.box, !fir.ref, i32) -> none + end module program test