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 @@ -4718,8 +4718,21 @@ emptyRange, tdesc); }); } else { - PushSemantics(ConstituentSemantics::BoxValue); - operands.emplace_back(genElementalArgument(*expr)); + ExtValue exv = asScalarRef(*expr); + if (fir::getBase(exv).getType().isa()) { + operands.emplace_back( + [=](IterSpace iters) -> ExtValue { return exv; }); + } else { + mlir::Type baseTy = + fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(exv).getType()); + operands.emplace_back([=](IterSpace iters) -> ExtValue { + mlir::Value empty; + mlir::ValueRange emptyRange; + return builder.create( + loc, fir::ClassType::get(baseTy), fir::getBase(exv), empty, + empty, emptyRange); + }); + } } break; } 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 @@ -14,6 +14,8 @@ procedure, pass(this) :: elemental_sub_pass generic :: assignment(=) => assign_p1_int procedure :: host_assoc + procedure, pass(poly) :: lt + generic :: operator(<) => lt end type type, extends(p1) :: p2 @@ -34,6 +36,10 @@ class(p3), pointer :: p(:) end type + type outer + type(p1) :: inner + end type + contains elemental subroutine assign_p1_int(lhs, rhs) @@ -67,6 +73,12 @@ this%a = this%a * this%b + c end subroutine + logical elemental function lt(i, poly) + integer, intent(in) :: i + class(p1), intent(in) :: poly + lt = i < poly%a + End Function + ! Test correct access to polymorphic entity component. subroutine component_access(p) class(p1) :: p @@ -670,3 +682,25 @@ ! CHECK: } end module + +program test + use polymorphic_test + type(outer), allocatable :: o + integer :: i(5) + logical :: l(5) + allocate(o) + + l = i < o%inner +end program + +! CHECK-LABEL: func.func @_QQmain() { +! CHECK: %[[ADDR_O:.*]] = fir.address_of(@_QFEo) : !fir.ref}>>>> +! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ADDR_O]] : (!fir.ref}>>>>) -> !fir.ref> +! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref>, i1, !fir.box, !fir.ref, i32) -> i32 +! CHECK: %[[O:.*]] = fir.load %[[ADDR_O]] : !fir.ref}>>>> +! CHECK: %[[FIELD_INNER:.*]] = fir.field_index inner, !fir.type<_QMpolymorphic_testTouter{inner:!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>}> +! CHECK: %[[COORD_INNER:.*]] = fir.coordinate_of %[[O]], %[[FIELD_INNER]] : (!fir.box}>>>, !fir.field) -> !fir.ref> +! CHECK: %{{.*}} = fir.do_loop %{{.*}} = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%arg1 = %9) -> (!fir.array<5x!fir.logical<4>>) { +! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD_INNER]] : (!fir.ref>) -> !fir.class> +! CHECK: %{{.*}} = fir.call @_QMpolymorphic_testPlt(%17, %[[EMBOXED]]) {{.*}} : (!fir.ref, !fir.class>) -> !fir.logical<4> +! CHECK: }