[flang-commits] [flang] 33c29a8 - [flang] Use runtime Assign when rhs is polymorphic

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2023-02-21T10:14:31+01:00
New Revision: 33c29a82a9b3b8a0354a5b5bd75b462505602107

URL: https://github.com/llvm/llvm-project/commit/33c29a82a9b3b8a0354a5b5bd75b462505602107
DIFF: https://github.com/llvm/llvm-project/commit/33c29a82a9b3b8a0354a5b5bd75b462505602107.diff

LOG: [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

Added: 
    

Modified: 
    flang/lib/Lower/Bridge.cpp
    flang/test/Lower/polymorphic.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 0a2cf3ca3ec30..65993f50311b9 100644
--- 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
index 6935261af4c6a..50efe0209580a 100644
--- 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