diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h --- a/flang/include/flang/Lower/ConvertExpr.h +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -79,6 +79,14 @@ AbstractConverter &converter, const SomeExpr &expr, SymMap &symMap); +/// Return true iif the expression is pointing to a parent component. +bool isParentComponent(const SomeExpr &expr); + +/// Update the extended value to represent the parent component. +fir::ExtendedValue updateBoxForParentComponent(AbstractConverter &converter, + fir::ExtendedValue exv, + const SomeExpr &expr); + /// Create a fir::BoxValue describing the value of \p expr. /// If \p expr is a variable without vector subscripts, the fir::BoxValue /// described the variable storage. Otherwise, the created fir::BoxValue 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 @@ -1753,6 +1753,11 @@ fir::getBase(exv)); } mlir::Value box = builder.createBox(loc, exv, exv.isPolymorphic()); + if (Fortran::lower::isParentComponent(expr)) { + fir::ExtendedValue newExv = + Fortran::lower::updateBoxForParentComponent(converter, box, expr); + box = fir::getBase(newExv); + } return fir::BoxValue( box, fir::factory::getNonDefaultLowerBounds(builder, loc, exv), fir::factory::getNonDeferredLenParams(exv)); @@ -7188,7 +7193,7 @@ .genMutableBoxValue(expr); } -bool isParentComponent(const Fortran::lower::SomeExpr &expr) { +bool Fortran::lower::isParentComponent(const Fortran::lower::SomeExpr &expr) { if (const Fortran::semantics::Symbol * symbol{GetLastSymbol(expr)}) { if (symbol->test(Fortran::semantics::Symbol::Flag::ParentComp)) return true; @@ -7196,24 +7201,6 @@ return false; } -template -mlir::Value createSliceForParentComp(fir::FirOpBuilder &builder, - mlir::Location loc, OP boxOp, - fir::ExtendedValue box, mlir::Value field, - bool isArray) { - if (boxOp.getSlice()) { - mlir::Value existingSlice = boxOp.getSlice(); - fir::SliceOp sliceOp = - mlir::dyn_cast(existingSlice.getDefiningOp()); - llvm::SmallVector fields = sliceOp.getFields(); - fields.push_back(field); - return builder.createSlice(loc, box, sliceOp.getTriples(), fields); - } - if (isArray) - return builder.createSlice(loc, box, {}, {field}); - return {}; -} - // Handling special case where the last component is referring to the // parent component. // @@ -7228,10 +7215,9 @@ // y(:)%t ! just need to update the box with a slice pointing to the first // ! component of `t`. // a%t ! simple conversion to TYPE(t). -fir::ExtendedValue -updateBoxForParentComponent(Fortran::lower::AbstractConverter &converter, - fir::ExtendedValue box, - const Fortran::lower::SomeExpr &expr) { +fir::ExtendedValue Fortran::lower::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); 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 @@ -1039,6 +1039,22 @@ ! CHECK: %[[A_CONV:.*]] = fir.convert %[[A]] : (!fir.ref>>) -> !fir.ref> ! CHECK: %{{.*}} = fir.call @_FortranAMoveAlloc(%[[B_CONV]], %[[A_CONV]], %[[NULL]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref>, !fir.ref>, !fir.ref, i1, !fir.box, !fir.ref, i32) -> i32 + subroutine test_parent_comp_intrinsic(a, b) + class(p1) :: a + type(p2), allocatable :: b + logical :: c + + c = same_type_as(a, b%p1) + end subroutine + +! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_parent_comp_intrinsic( +! CHECK-SAME: %[[ARG0:.*]]: !fir.class> {fir.bindc_name = "a"}, %[[ARG1:.*]]: !fir.ref>>> {fir.bindc_name = "b"}) { +! CHECK: %[[LOAD_ARG1:.*]] = fir.load %[[ARG1]] : !fir.ref>>> +! CHECK: %[[REBOX_ARG1:.*]] = fir.rebox %[[LOAD_ARG1]] : (!fir.box>>) -> !fir.box> +! CHECK: %[[BOX_NONE_ARG0:.*]] = fir.convert %[[ARG0]] : (!fir.class>) -> !fir.box +! CHECK: %[[BOX_NONE_ARG1:.*]] = fir.convert %[[REBOX_ARG1]] : (!fir.box>) -> !fir.box +! CHECK: %{{.*}} = fir.call @_FortranASameTypeAs(%[[BOX_NONE_ARG0]], %[[BOX_NONE_ARG1]]) {{.*}} : (!fir.box, !fir.box) -> i1 + end module program test