[flang-commits] [flang] 4f3c985 - [flang] Use AssignPolymorphic when LHS is polymorphic

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2023-03-06T09:36:09+01:00
New Revision: 4f3c98542bebac90546a03363e5956f9862ae985

URL: https://github.com/llvm/llvm-project/commit/4f3c98542bebac90546a03363e5956f9862ae985
DIFF: https://github.com/llvm/llvm-project/commit/4f3c98542bebac90546a03363e5956f9862ae985.diff

LOG: [flang] Use AssignPolymorphic when LHS is polymorphic

Make use of the new runtime entry point for assignment to
LHS allocatable polymorphic.

Reviewed By: jeanPerier

Differential Revision: https://reviews.llvm.org/D145324

Added: 
    

Modified: 
    flang/include/flang/Optimizer/Builder/Runtime/Assign.h
    flang/lib/Lower/Bridge.cpp
    flang/lib/Optimizer/Builder/Runtime/Assign.cpp
    flang/test/Lower/polymorphic.f90

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Optimizer/Builder/Runtime/Assign.h b/flang/include/flang/Optimizer/Builder/Runtime/Assign.h
index 5c02d4e9b71df..9010013086623 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Assign.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Assign.h
@@ -28,5 +28,12 @@ namespace fir::runtime {
 void genAssign(fir::FirOpBuilder &builder, mlir::Location loc,
                mlir::Value destBox, mlir::Value sourceBox);
 
+/// Generate runtime call to AssignPolymorphic \p sourceBox to \p destBox.
+/// \p destBox must be a fir.ref<fir.box<T>> and \p sourceBox a fir.box<T>.
+/// \p destBox Fortran descriptor may be modified if destBox is an allocatable
+/// according to Fortran allocatable assignment rules.
+void genAssignPolymorphic(fir::FirOpBuilder &builder, mlir::Location loc,
+                          mlir::Value destBox, mlir::Value sourceBox);
+
 } // namespace fir::runtime
 #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ASSIGN_H

diff  --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 887ce66565c0e..5d5bb53d209a4 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3038,7 +3038,12 @@ class FirConverter : public Fortran::lower::AbstractConverter {
                   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);
+                if ((lhsType->IsPolymorphic() ||
+                     lhsType->IsUnlimitedPolymorphic()) &&
+                    Fortran::lower::isWholeAllocatable(assign.lhs))
+                  fir::runtime::genAssignPolymorphic(*builder, loc, lhs, rhs);
+                else
+                  fir::runtime::genAssign(*builder, loc, lhs, rhs);
                 return;
               }
 

diff  --git a/flang/lib/Optimizer/Builder/Runtime/Assign.cpp b/flang/lib/Optimizer/Builder/Runtime/Assign.cpp
index 54eef2094a82e..785afc79ee7cd 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Assign.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Assign.cpp
@@ -24,3 +24,17 @@ void fir::runtime::genAssign(fir::FirOpBuilder &builder, mlir::Location loc,
                                             sourceBox, sourceFile, sourceLine);
   builder.create<fir::CallOp>(loc, func, args);
 }
+
+void fir::runtime::genAssignPolymorphic(fir::FirOpBuilder &builder,
+                                        mlir::Location loc, mlir::Value destBox,
+                                        mlir::Value sourceBox) {
+  auto func =
+      fir::runtime::getRuntimeFunc<mkRTKey(AssignPolymorphic)>(loc, builder);
+  auto fTy = func.getFunctionType();
+  auto sourceFile = fir::factory::locationToFilename(builder, loc);
+  auto sourceLine =
+      fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
+  auto args = fir::runtime::createArguments(builder, loc, fTy, destBox,
+                                            sourceBox, sourceFile, sourceLine);
+  builder.create<fir::CallOp>(loc, func, args);
+}

diff  --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90
index f2e7cac545625..16757ff279a86 100644
--- a/flang/test/Lower/polymorphic.f90
+++ b/flang/test/Lower/polymorphic.f90
@@ -411,7 +411,7 @@ subroutine assign_polymorphic_allocatable()
 ! CHECK: %[[BOXED_T:.*]] = fir.embox %[[T]](%[[SHAPE]]) : (!fir.ref<!fir.array<10x20x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, !fir.shape<2>) -> !fir.box<!fir.array<10x20x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>
 ! CHECK: %[[CONV_C:.*]] = fir.convert %[[C]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>
 ! CHECK: %[[CONV_BOXED_T:.*]] = fir.convert %[[BOXED_T]] : (!fir.box<!fir.array<10x20x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>
-! CHECK: %{{.*}} = fir.call @_FortranAAssign(%[[CONV_C]], %[[CONV_BOXED_T]], %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK: %{{.*}} = fir.call @_FortranAAssignPolymorphic(%[[CONV_C]], %[[CONV_BOXED_T]], %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> none
 ! CHECK: return
 
   subroutine pointer_assign_remap()