diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Assign.h b/flang/include/flang/Optimizer/Builder/Runtime/Assign.h --- a/flang/include/flang/Optimizer/Builder/Runtime/Assign.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Assign.h @@ -35,5 +35,18 @@ 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> and \p sourceBox a fir.box. +/// \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 --- a/flang/lib/Optimizer/Builder/Runtime/Assign.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Assign.cpp @@ -38,3 +38,19 @@ sourceBox, sourceFile, sourceLine); builder.create(loc, func, args); } + +void fir::runtime::genAssignExplicitLengthCharacter(fir::FirOpBuilder &builder, + mlir::Location loc, + mlir::Value destBox, + mlir::Value sourceBox) { + auto func = + fir::runtime::getRuntimeFunc( + 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(loc, func, args); +} diff --git a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp --- a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp +++ b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp @@ -112,11 +112,11 @@ // 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 --- a/flang/test/HLFIR/assign-codegen.fir +++ b/flang/test/HLFIR/assign-codegen.fir @@ -183,3 +183,26 @@ // CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_0]] : (!fir.ref>>>) -> !fir.ref> // CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_1]] : (!fir.box>) -> !fir.box // CHECK: fir.call @_FortranAAssign(%[[VAL_2]], %[[VAL_3]], %{{.*}}, %{{.*}}) : (!fir.ref>, !fir.box, !fir.ref, i32) -> none + + +func.func @test_alloc_assign_explicit_length_character(%lhs: !fir.ref>>>>, %rhs: !fir.box>>) { + hlfir.assign %rhs to %lhs realloc keep_lhs_len : !fir.box>>, !fir.ref>>>> + return +} +// CHECK-LABEL: func.func @test_alloc_assign_explicit_length_character( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>>, +// CHECK-SAME: %[[VAL_1:.*]]: !fir.box>>) { +// CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_0]] : (!fir.ref>>>>) -> !fir.ref> +// CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_1]] : (!fir.box>>) -> !fir.box +// CHECK: %[[VAL_10:.*]] = fir.call @_FortranAAssignExplicitLengthCharacter(%[[VAL_7]], %[[VAL_8]], %{{.*}}, %{{.*}}) : (!fir.ref>, !fir.box, !fir.ref, i32) -> none + +func.func @test_alloc_assign_polymorphic(%lhs: !fir.ref>>>>, %rhs: !fir.class>>) { + hlfir.assign %rhs to %lhs realloc : !fir.class>>, !fir.ref>>>> + return +} +// CHECK-LABEL: func.func @test_alloc_assign_polymorphic( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>>, +// CHECK-SAME: %[[VAL_1:.*]]: !fir.class>>) { +// CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_0]] : (!fir.ref>>>>) -> !fir.ref> +// CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_1]] : (!fir.class>>) -> !fir.box +// CHECK: %[[VAL_10:.*]] = fir.call @_FortranAAssignPolymorphic(%[[VAL_7]], %[[VAL_8]], %{{.*}}, %{{.*}}) : (!fir.ref>, !fir.box, !fir.ref, i32) -> none