diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -32,6 +32,7 @@ #include "flang/Optimizer/Builder/BoxValue.h" #include "flang/Optimizer/Builder/Character.h" #include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Builder/Runtime/Assign.h" #include "flang/Optimizer/Builder/Runtime/Character.h" #include "flang/Optimizer/Builder/Runtime/Derived.h" #include "flang/Optimizer/Builder/Runtime/EnvironmentDefaults.h" @@ -2633,8 +2634,13 @@ // Assignment to polymorphic allocatables may require changing the // variable dynamic type (See Fortran 2018 10.2.1.3 p3). if (lhsType->IsPolymorphic() && - Fortran::lower::isWholeAllocatable(assign.lhs)) - TODO(loc, "assignment to polymorphic allocatable"); + Fortran::lower::isWholeAllocatable(assign.lhs)) { + mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr(); + mlir::Value rhs = + fir::getBase(genExprBox(loc, assign.rhs, stmtCtx)); + fir::runtime::genAssign(*builder, loc, lhs, rhs); + return; + } // Note: No ad-hoc handling for pointers is required here. The // target will be assigned as per 2018 10.2.1.3 p2. genExprAddr 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 @@ -301,4 +301,27 @@ ! CHECK: %[[UP:.*]] = fir.convert %[[BOX_COMPLEX]] : (!fir.class>) -> !fir.class ! CHECK: fir.call @_QMpolymorphic_testPup_input(%[[UP]]) {{.*}} : (!fir.class) -> () + subroutine assign_polymorphic_allocatable() + type(p1), target :: t(10,20) + class(p1), allocatable :: c(:,:) + c = t + end subroutine + +! CHECK-LABEL: func.func @_QMpolymorphic_testPassign_polymorphic_allocatable() { +! CHECK: %[[C:.*]] = fir.alloca !fir.class>>> {bindc_name = "c", uniq_name = "_QMpolymorphic_testFassign_polymorphic_allocatableEc"} +! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.heap>> +! CHECK: %[[C0:.*]] = arith.constant 0 : index +! CHECK: %[[SHAPE_C:.*]] = fir.shape %[[C0]], %[[C0]] : (index, index) -> !fir.shape<2> +! CHECK: %[[EMBOX:.*]] = fir.embox %[[ZERO]](%[[SHAPE_C]]) : (!fir.heap>>, !fir.shape<2>) -> !fir.class>>> +! CHECK: fir.store %[[EMBOX]] to %[[C]] : !fir.ref>>>> +! CHECK: %[[C10:.*]] = arith.constant 10 : index +! CHECK: %[[C20:.*]] = arith.constant 20 : index +! CHECK: %[[T:.*]] = fir.alloca !fir.array<10x20x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {bindc_name = "t", fir.target, uniq_name = "_QMpolymorphic_testFassign_polymorphic_allocatableEt"} +! CHECK: %[[SHAPE:.*]] = fir.shape %[[C10]], %[[C20]] : (index, index) -> !fir.shape<2> +! CHECK: %[[BOXED_T:.*]] = fir.embox %[[T]](%[[SHAPE]]) : (!fir.ref>>, !fir.shape<2>) -> !fir.box>> +! CHECK: %[[CONV_C:.*]] = fir.convert %[[C]] : (!fir.ref>>>>) -> !fir.ref> +! CHECK: %[[CONV_BOXED_T:.*]] = fir.convert %[[BOXED_T]] : (!fir.box>>) -> !fir.box +! CHECK: %{{.*}} = fir.call @_FortranAAssign(%[[CONV_C]], %[[CONV_BOXED_T]], %{{.*}}, %{{.*}}) fastmath : (!fir.ref>, !fir.box, !fir.ref, i32) -> none +! CHECK: return + end module