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 @@ -2970,8 +2970,9 @@ return fir::factory::CharacterExprHelper{builder, loc}.createEmbox( *charBox); } - if (argType.isa()) { - mlir::Value box = builder.createBox(loc, value); + if (argType.isa()) { + mlir::Value box = + builder.createBox(loc, value, argType.isa()); return builder.createConvert(loc, argType, box); } // Simple pass by address. @@ -7171,7 +7172,7 @@ } bool isParentComponent(const Fortran::lower::SomeExpr &expr) { - if (const Fortran::semantics::Symbol * symbol{GetLastSymbol(expr)}) { + if (const Fortran::semantics::Symbol *symbol{GetLastSymbol(expr)}) { if (symbol->test(Fortran::semantics::Symbol::Flag::ParentComp)) return true; } 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 @@ -8,6 +8,8 @@ integer :: b contains procedure :: print + procedure :: assign_p1_int + generic :: assignment(=) => assign_p1_int end type type, extends(p1) :: p2 @@ -30,6 +32,13 @@ contains + elemental subroutine assign_p1_int(lhs, rhs) + class(p1), intent(inout) :: lhs + integer, intent(in) :: rhs + lhs%a = rhs + lhs%b = rhs + End Subroutine + ! Test correct access to polymorphic entity component. subroutine component_access(p) class(p1) :: p @@ -375,4 +384,33 @@ ! CHECK: %[[ARG2:.*]] = fir.convert %[[BOXED_BOUND_ARRAY]] : (!fir.box>) -> !fir.box ! CHECK: %{{.*}} = fir.call @_FortranAPointerAssociateRemapping(%[[ARG0]], %[[ARG1]], %[[ARG2]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref>, !fir.box, !fir.box, !fir.ref, i32) -> none + subroutine test_elemental_assign() + type(p1) :: pa(3) + pa = [ 1, 2, 3 ] + end subroutine + +! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_elemental_assign() { +! CHECK: %[[INT:.*]] = fir.alloca i32 +! CHECK: %[[C3_0:.*]] = arith.constant 3 : index +! CHECK: %[[PA:.*]] = fir.alloca !fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {bindc_name = "pa", uniq_name = "_QMpolymorphic_testFtest_elemental_assignEpa"} +! CHECK: %[[SHAPE:.*]] = fir.shape %[[C3_0]] : (index) -> !fir.shape<1> +! CHECK: %[[LOAD_PA:.*]] = fir.array_load %[[PA]](%[[SHAPE]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> +! CHECK: %[[ADDR_INT:.*]] = fir.address_of(@_QQro.3xi4.{{.*}}) : !fir.ref> +! CHECK: %[[C3:.*]] = arith.constant 3 : index +! CHECK: %[[SHAPE:.*]] = fir.shape %[[C3]] : (index) -> !fir.shape<1> +! CHECK: %[[LOAD_INT_ARRAY:.*]] = fir.array_load %[[ADDR_INT]](%[[SHAPE]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<3xi32> +! CHECK: %[[C1:.*]] = arith.constant 1 : index +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[UB:.*]] = arith.subi %[[C3_0]], %[[C1]] : index +! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[ARG0:.*]] = %[[C0]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG1:.*]] = %[[LOAD_PA]]) -> (!fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) { +! CHECK: %[[FETCH_INT:.*]] = fir.array_fetch %[[LOAD_INT_ARRAY]], %[[ARG0]] : (!fir.array<3xi32>, index) -> i32 +! CHECK: %[[ARRAY_MOD:.*]]:2 = fir.array_modify %[[ARG1]], %[[ARG0]] : (!fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, index) -> (!fir.ref>, !fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) +! CHECK: %[[EMBOXED:.*]] = fir.embox %10#0 : (!fir.ref>) -> !fir.class> +! CHECK: fir.store %[[FETCH_INT]] to %[[INT]] : !fir.ref +! CHECK: fir.call @_QMpolymorphic_testPassign_p1_int(%[[EMBOXED]], %[[INT]]) fastmath : (!fir.class>, !fir.ref) -> () +! CHECK: fir.result %[[ARRAY_MOD]]#1 : !fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> +! CHECK: } +! CHECK: fir.array_merge_store %[[LOAD_PA]], %[[DO_RES]] to %[[PA]] : !fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.ref>> +! CHECK: return + end module