[flang][hlfir] use new runtime for whole allocatable assignment

[jeanPerier]

Summary

• use AssignExplicitLengthCharacter for assignment to whole allocatable character with assumed or explicit length.
• use AssignPolymorphic for assignment to whole allocatable polymorphic.

[clementval]

LGTM

flang/include/flang/Optimizer/Builder/Runtime/Assign.h

 
 /// 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);
 
+/// Generate runtime call to AssignExplicitLengthCharacter to assign
+/// \p sourceBox to \p destBox where \p destBox is a whole allocatable character
+/// with explicit or assumed length. After the assignment, the length of
+/// \p destBox will remain what it was, even if allocation or reallocation
+/// occurred. For assignments to a whole allocatable with deferred length,
+/// genAssign should be used.
+/// \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 genAssignExplicitLengthCharacter(fir::FirOpBuilder &builder,
+                                      mlir::Location loc, mlir::Value destBox,
+                                      mlir::Value sourceBox);
+
 } // namespace fir::runtime
 #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ASSIGN_H

flang/lib/Optimizer/Builder/Runtime/Assign.cpp

void fir::runtime::genAssignPolymorphic(fir::FirOpBuilder &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);
 }
+
+void fir::runtime::genAssignExplicitLengthCharacter(fir::FirOpBuilder &builder,
+                                                    mlir::Location loc,
+                                                    mlir::Value destBox,
+                                                    mlir::Value sourceBox) {
+  auto func =
+      fir::runtime::getRuntimeFunc<mkRTKey(AssignExplicitLengthCharacter)>(
+          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);
+}

flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp

if (assignOp.isAllocatableAssignment()) {
       // Whole allocatable assignment: use the runtime to deal with the
       // reallocation.
       mlir::Value from = emboxRHS(rhsExv);
       mlir::Value to = fir::getBase(lhsExv);
       if (assignOp.mustKeepLhsLengthInAllocatableAssignment()) {
         // Indicate the runtime that it should not reallocate in case of length
         // mismatch, and that it should use the LHS explicit/assumed length if
         // allocating/reallocation the LHS.
-        TODO(loc, "assignment to explicit length whole allocatable");
+        fir::runtime::genAssignExplicitLengthCharacter(builder, loc, to, from);
       } else if (lhs.isPolymorphic()) {
         // Indicate the runtime that the LHS must have the RHS dynamic type
         // after the assignment.
-        TODO(loc, "assignment to whole polymorphic entity");
+        fir::runtime::genAssignPolymorphic(builder, loc, to, from);
       } else {
         fir::runtime::genAssign(builder, loc, to, from);
       }
     } else if (lhs.isArray()) {
       // Use the runtime for simplicity. An optimization pass will be added to
       // inline array assignment when profitable.
       mlir::Value from = emboxRHS(rhsExv);
       mlir::Value to = fir::getBase(builder.createBox(loc, lhsExv));

flang/test/HLFIR/assign-codegen.fir

func.func @alloc_assign(%arg0: !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>, %arg1: !fir.box<!fir.array<?xi32>>) {
   return
 }
 // CHECK-LABEL:  func.func @alloc_assign(
 // CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>,
 // CHECK-SAME: %[[VAL_1:.*]]: !fir.box<!fir.array<?xi32>>) {
 // CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
 // CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_1]] : (!fir.box<!fir.array<?xi32>>) -> !fir.box<none>
 // CHECK:  fir.call @_FortranAAssign(%[[VAL_2]], %[[VAL_3]], %{{.*}}, %{{.*}}) : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+
+
+func.func @test_alloc_assign_explicit_length_character(%lhs: !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>, %rhs: !fir.box<!fir.array<?x!fir.char<1,?>>>) {
+  hlfir.assign %rhs to %lhs realloc keep_lhs_len : !fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>
+  return
+}
+// CHECK-LABEL:   func.func @test_alloc_assign_explicit_length_character(
+// CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>,
+// CHECK-SAME:  %[[VAL_1:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>>) {
+// CHECK:  %[[VAL_7:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>) -> !fir.ref<!fir.box<none>>
+// CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_1]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.box<none>
+// CHECK:  %[[VAL_10:.*]] = fir.call @_FortranAAssignExplicitLengthCharacter(%[[VAL_7]], %[[VAL_8]], %{{.*}}, %{{.*}}) : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+
+func.func @test_alloc_assign_polymorphic(%lhs: !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<t>>>>>, %rhs: !fir.class<!fir.array<?x!fir.type<t>>>) {
+  hlfir.assign %rhs to %lhs realloc : !fir.class<!fir.array<?x!fir.type<t>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<t>>>>>
+  return
+}
+// CHECK-LABEL:   func.func @test_alloc_assign_polymorphic(
+// CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<t>>>>>,
+// CHECK-SAME:  %[[VAL_1:.*]]: !fir.class<!fir.array<?x!fir.type<t>>>) {
+// CHECK:  %[[VAL_7:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<t>>>>>) -> !fir.ref<!fir.box<none>>
+// CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_1]] : (!fir.class<!fir.array<?x!fir.type<t>>>) -> !fir.box<none>
+// CHECK:  %[[VAL_10:.*]] = fir.call @_FortranAAssignPolymorphic(%[[VAL_7]], %[[VAL_8]], %{{.*}}, %{{.*}}) : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> none