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

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

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

diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Assign.h b/flang/include/flang/Optimizer/Builder/Runtime/Assign.h
index 9010013..f33a76a 100644 (file)
--- a/flang/include/flang/Optimizer/Builder/Runtime/Assign.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Assign.h
@@ -35,5 +35,18 @@ void genAssign(fir::FirOpBuilder &builder, mlir::Location loc,
 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

diff --git a/flang/lib/Optimizer/Builder/Runtime/Assign.cpp b/flang/lib/Optimizer/Builder/Runtime/Assign.cpp
index 785afc7..db4de8a 100644 (file)
--- a/flang/lib/Optimizer/Builder/Runtime/Assign.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Assign.cpp
@@ -38,3 +38,19 @@ void fir::runtime::genAssignPolymorphic(fir::FirOpBuilder &builder,
                                             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);
+}

diff --git a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
index 160a77c..d627c96 100644 (file)
--- a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
+++ b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
@@ -112,11 +112,11 @@ public:
         // 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);
       }

diff --git a/flang/test/HLFIR/assign-codegen.fir b/flang/test/HLFIR/assign-codegen.fir
index 06c4ae1..6da5acc 100644 (file)
--- a/flang/test/HLFIR/assign-codegen.fir
+++ b/flang/test/HLFIR/assign-codegen.fir
@@ -183,3 +183,26 @@ func.func @alloc_assign(%arg0: !fir.ref<!fir.box<!fir.heap<!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