[flang] Use runtime Assign when rhs is polymorphic

Use the runtime when there lhs or rhs is polymorphic. The runtime allows to deal better with polymorphic entities and aliasing. Reviewed By: PeteSteinfeld Differential Revision: https://reviews.llvm.org/D144418
llvm · Feb 21, 2023 · 33c29a8 · 33c29a8
1 parent 0c444ff
commit 33c29a8
Show file tree

Hide file tree

Showing 2 changed files with 32 additions and 7 deletions.
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
@@ -2854,13 +2854,20 @@ class FirConverter : public Fortran::lower::AbstractConverter {
               std::optional<Fortran::evaluate::DynamicType> lhsType =
                   assign.lhs.GetType();
               assert(lhsType && "lhs cannot be typeless");
-
-              // Assignment to polymorphic allocatables may require changing the
-              // variable dynamic type (See Fortran 2018 10.2.1.3 p3).
-              if ((lhsType->IsPolymorphic() ||
-                   lhsType->IsUnlimitedPolymorphic()) &&
-                  Fortran::lower::isWholeAllocatable(assign.lhs)) {
-                mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr();
+              std::optional<Fortran::evaluate::DynamicType> rhsType =
+                  assign.rhs.GetType();
+
+              // Assignment to/from polymorphic entities are done with the
+              // runtime.
+              if (lhsType->IsPolymorphic() ||
+                  lhsType->IsUnlimitedPolymorphic() ||
+                  rhsType->IsPolymorphic() ||
+                  rhsType->IsUnlimitedPolymorphic()) {
+                mlir::Value lhs;
+                if (Fortran::lower::isWholeAllocatable(assign.lhs))
+                  lhs = genExprMutableBox(loc, assign.lhs).getAddr();
+                else
+                  lhs = fir::getBase(genExprBox(loc, assign.lhs, stmtCtx));
                 mlir::Value rhs =
                     fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
                 fir::runtime::genAssign(*builder, loc, lhs, rhs);

diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90
@@ -933,6 +933,24 @@ subroutine opt_up(up)
     class(*), optional, intent(in) :: up
   end subroutine
 
+  function rhs()
+    class(p1), pointer :: rhs
+  end function
+
+  subroutine test_rhs_assign(a)
+    type(p1) :: a
+    a = rhs()
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_rhs_assign(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"}) {
+! CHECK: %[[RES:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {bindc_name = ".result"}
+! CHECK: %[[A:.*]] = fir.embox %[[ARG0]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK: %[[LOAD_RES:.*]] = fir.load %[[RES]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>
+! CHECK: %[[A_NONE:.*]] = fir.convert %[[A]] : (!fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[RES_NONE:.*]] = fir.convert %[[LOAD_RES]] : (!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranAAssign(%[[A_NONE]], %[[RES_NONE]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+
 end module
 
 program test