[flang] Relax fir.rebox verifier with characters

[jeanPerier]

Summary

Allow fir.rebox input and output element type to differ for characters
if:

• Any of the character type is dynamic. Fortran allows making pointer

assignments between deferred and constant lengths entities, making this
case useful (if the input length is dynamic and the output length constant,
it is a user requirement that the length matches at runtime. There is no
option to check this at runtime, but it could be added as an option to
fir.rebox codegen later if desired).

• Or, there is a slice in the fir.rebox (the fir.rebox can implement a

substring view, hence the constant output and input lengths).

This is only a verifier constraint change, the fir.rebox codegen is not
impacted and already support those cases.

Add related FIR parsing, error, and codegen tests.

[schweitz]

LGTM except for some potential build issue.

[jeanPerier]

Remove leftover dbg tag from test (caught by buildbot).
Make logic more readable by using a named variable.

[clementval]

LGTM

flang/lib/Optimizer/Dialect/FIROps.cpp

 /// Get the rank from a !fir.box type
 static unsigned getBoxRank(mlir::Type boxTy) {
   auto eleTy = fir::dyn_cast_ptrOrBoxEleTy(boxTy);
   if (auto seqTy = eleTy.dyn_cast<fir::SequenceType>())
     return seqTy.getDimension();
   return 0;
 }
 
+/// Test if \p t1 and \p t2 are compatible character types (if they can
+/// represent the same type at runtime).
+static bool areCompatibleCharacterTypes(mlir::Type t1, mlir::Type t2) {
+  auto c1 = t1.dyn_cast<fir::CharacterType>();
+  auto c2 = t2.dyn_cast<fir::CharacterType>();
+  if (!c1 || !c2)
+    return false;
+  if (c1.hasDynamicLen() || c2.hasDynamicLen())
+    return true;
+  return c1.getLen() == c2.getLen();
+}
+
 mlir::LogicalResult ReboxOp::verify() {
   auto inputBoxTy = getBox().getType();
   if (fir::isa_unknown_size_box(inputBoxTy))
     return emitOpError("box operand must not have unknown rank or type");
   auto outBoxTy = getType();
   if (fir::isa_unknown_size_box(outBoxTy))
     return emitOpError("result type must not have unknown rank or type");
   auto inputRank = getBoxRank(inputBoxTy);
if (auto shapeVal = getShape()) {
           return emitOpError("shape operand and input box ranks must match "
                              "when the shape is a fir.shift");
       }
     }
     if (shapeRank != outRank)
       return emitOpError("result type and shape operand ranks must match");
   }
 
-  if (inputEleTy != outEleTy)
+  if (inputEleTy != outEleTy) {
     // TODO: check that outBoxTy is a parent type of inputBoxTy for derived
     // types.
-    if (!inputEleTy.isa<fir::RecordType>())
+    // Character input and output types with constant length may be different if
+    // there is a substring in the slice, otherwise, they must match. If any of
+    // the types is a character with dynamic length, the other type can be any
+    // character type.
+    const bool typeCanMismatch =
+        inputEleTy.isa<fir::RecordType>() ||
+        (getSlice() && inputEleTy.isa<fir::CharacterType>()) ||
+        areCompatibleCharacterTypes(inputEleTy, outEleTy);
+    if (!typeCanMismatch)
       return emitOpError(
           "op input and output element types must match for intrinsic types");
+  }
   return mlir::success();
 }
 
 //===----------------------------------------------------------------------===//
 // ResultOp
 //===----------------------------------------------------------------------===//
 
 mlir::LogicalResult ResultOp::verify() {

flang/test/Fir/fir-ops.fir

func @test_rebox(%arg0: !fir.box<!fir.array<?xf32>>) {
   %2 = fir.rebox %arg0(%1) [%0] : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>, !fir.slice<1>) -> !fir.box<!fir.array<?xf32>>
   %3 = fir.shape %c3, %c4 : (index, index) -> !fir.shape<2>
   // CHECK: fir.rebox %{{.*}}(%{{.*}}) : (!fir.box<!fir.array<?xf32>>, !fir.shape<2>) -> !fir.box<!fir.array<?x?xf32>>
   %4 = fir.rebox %2(%3) : (!fir.box<!fir.array<?xf32>>, !fir.shape<2>) -> !fir.box<!fir.array<?x?xf32>>
   fir.call @bar_rebox_test(%4) : (!fir.box<!fir.array<?x?xf32>>) -> ()
   return
 }
 
+func private @bar_rebox_test_char(!fir.box<!fir.array<?x!fir.char<1,?>>>)
+// CHECK-LABEL: @test_rebox_char(
+func @test_rebox_char(%arg0: !fir.box<!fir.array<?x!fir.char<1,20>>>) {
+  %c7_i64 = arith.constant 7 : i64
+  %c1_i64 = arith.constant 1 : i64
+  %c0 = arith.constant 0 : index
+  %c1 = arith.constant 1 : index
+  %0:3 = fir.box_dims %arg0, %c0 : (!fir.box<!fir.array<?x!fir.char<1,20>>>, index) -> (index, index, index)
+  %1 = fir.slice %c1, %0#1, %c1_i64 substr %c1_i64, %c7_i64 : (index, index, i64, i64, i64) -> !fir.slice<1>
+  // CHECK: fir.rebox %{{.*}} [%{{.*}}] : (!fir.box<!fir.array<?x!fir.char<1,20>>>, !fir.slice<1>) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
+  %2 = fir.rebox %arg0 [%1] : (!fir.box<!fir.array<?x!fir.char<1,20>>>, !fir.slice<1>) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
+  fir.call @bar_rebox_test_char(%2) : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> ()
+  return
+}
+
+
+func private @array_func() -> !fir.array<?x!fir.char<1,?>>
 // CHECK-LABEL: @test_save_result(
 func @test_save_result(%buffer: !fir.ref<!fir.array<?x!fir.char<1,?>>>) {
   %c100 = arith.constant 100 : index
   %c50 = arith.constant 50 : index
   %shape = fir.shape %c100 : (index) -> !fir.shape<1>
   %res = fir.call @array_func() : () -> !fir.array<?x!fir.char<1,?>>
   // CHECK: fir.save_result %{{.*}} to %{{.*}}(%{{.*}}) typeparams %{{.*}} : !fir.array<?x!fir.char<1,?>>, !fir.ref<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index
   fir.save_result %res to %buffer(%shape) typeparams %c50 : !fir.array<?x!fir.char<1,?>>, !fir.ref<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index

flang/test/Fir/invalid.fir

func @bad_rebox_11(%arg0: !fir.box<!fir.array<?x?xf32>>) {
   %0 = fir.shape %c42 : (index) -> !fir.shape<1>
   // expected-error@+1{{op input and output element types must match for intrinsic types}}
   %1 = fir.rebox %arg0(%0) : (!fir.box<!fir.array<?x?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf64>>
   return
 }
 
 // -----
 
+func @test_rebox_char(%arg0: !fir.box<!fir.array<?x!fir.char<1,20>>>) {
+  %c10 = arith.constant 10 : index
+  %1 = fir.shape %c10, %c10 : (index, index) -> !fir.shape<2>
+  // expected-error@+1{{op input and output element types must match for intrinsic types}}
+  %2 = fir.rebox %arg0(%1) : (!fir.box<!fir.array<?x!fir.char<1,20>>>, !fir.shape<2>) -> !fir.box<!fir.array<10x10x!fir.char<1,10>>>
+  return
+}
+
+// -----
+
 func @array_access(%arr : !fir.ref<!fir.array<?x?xf32>>) {
   %c1 = arith.constant 1 : index
   %c100 = arith.constant 100 : index
   %c50 = arith.constant 50 : index
   %shape = fir.shape %c100, %c50 : (index, index) -> !fir.shape<2>
   // expected-error@+1 {{'fir.array_coor' op operand #0 must be any reference or box, but got 'index'}}
   %p = fir.array_coor %c100(%shape) %c1, %c1 : (index, !fir.shape<2>, index, index) -> !fir.ref<f32>
   return

flang/test/Fir/rebox-susbtring.fir

+// Test translation to llvm IR of fir.rebox with substring array sections.
+
+// RUN: tco -o - -cg-rewrite --fir-to-llvm-ir -cse %s | FileCheck %s
+
+// Test a fir.rebox with a substring on a character array with constant
+// length (like c(:)(2:*) where c is a fir.box array with constant length).
+
+// CHECK-LABEL: llvm.func @char_section(
+// CHECK-SAME:                          %[[VAL_0:.*]]: !llvm.ptr<[[char20_descriptor_t:.*]]>)>>) {
+func @char_section(%arg0: !fir.box<!fir.array<?x!fir.char<1,20>>>) {
+  %c7_i64 = arith.constant 7 : i64
+  %c1_i64 = arith.constant 1 : i64
+  %c0 = arith.constant 0 : index
+  %c1 = arith.constant 1 : index
+  %0:3 = fir.box_dims %arg0, %c0 : (!fir.box<!fir.array<?x!fir.char<1,20>>>, index) -> (index, index, index)
+  %1 = fir.slice %c1, %0#1, %c1_i64 substr %c1_i64, %c7_i64 : (index, index, i64, i64, i64) -> !fir.slice<1>
+
+// Only test the computation of the base address offset computation accounting for the substring
+
+// CHECK:         %[[VAL_4:.*]] = llvm.mlir.constant(1 : i64) : i64
+// CHECK:         %[[VAL_7:.*]] = llvm.mlir.constant(0 : i32) : i32
+// CHECK:         %[[VAL_30:.*]] = llvm.mlir.constant(0 : i64) : i64
+
+// CHECK:         %[[VAL_37:.*]] = llvm.getelementptr %[[VAL_0]]{{\[}}%[[VAL_7]], 0] : (!llvm.ptr<[[char20_descriptor_t]]>)>>, i32) -> !llvm.ptr<ptr<array<20 x i8>>>
+// CHECK:         %[[VAL_38:.*]] = llvm.load %[[VAL_37]] : !llvm.ptr<ptr<array<20 x i8>>>
+// CHECK:         %[[VAL_39:.*]] = llvm.bitcast %[[VAL_38]] : !llvm.ptr<array<20 x i8>> to !llvm.ptr<array<20 x i8>>
+// CHECK:         %[[VAL_40:.*]] = llvm.getelementptr %[[VAL_39]]{{\[}}%[[VAL_30]], %[[VAL_4]]] : (!llvm.ptr<array<20 x i8>>, i64, i64) -> !llvm.ptr<array<20 x i8>>
+// CHECK:         llvm.bitcast %[[VAL_40]] : !llvm.ptr<array<20 x i8>> to !llvm.ptr<i8>
+
+// More offset computation with descriptor strides and triplets that is not character specific ...
+
+  %2 = fir.rebox %arg0 [%1] : (!fir.box<!fir.array<?x!fir.char<1,20>>>, !fir.slice<1>) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
+  fir.call @bar(%2) : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> ()
+  return
+}
+
+// Test a rebox of an array section like x(3:60:9)%c(2:8) with both a triplet, a component and a substring where x is a fir.box.
+
+// CHECK-LABEL: llvm.func @foo(
+// CHECK-SAME:                 %[[VAL_0:.*]]: !llvm.ptr<struct<(ptr<[[struct_t:.*]]>, i64, i32, i8, i8, i8, i8, array<1 x array<3 x i64>>, ptr<i8>, array<1 x i64>)>>) {
+func private @bar(!fir.box<!fir.array<?x!fir.char<1,?>>>)
+func @foo(%arg0: !fir.box<!fir.array<?x!fir.type<t{i:i32,c:!fir.char<1,10>}>>>) {
+  %c7_i64 = arith.constant 7 : i64
+  %c1_i64 = arith.constant 1 : i64
+  %c9_i64 = arith.constant 9 : i64
+  %c60_i64 = arith.constant 60 : i64
+  %c3_i64 = arith.constant 3 : i64
+  %0 = fir.field_index c, !fir.type<t{i:i32,c:!fir.char<1,10>}>
+  %1 = fir.slice %c3_i64, %c60_i64, %c9_i64 path %0 substr %c1_i64, %c7_i64 : (i64, i64, i64, !fir.field, i64, i64) -> !fir.slice<1>
+
+// Only test the computation of the base address offset computation accounting for the substring of the component
+
+// CHECK:         %[[VAL_1:.*]] = llvm.mlir.constant(1 : i32) : i32
+// CHECK:         %[[VAL_4:.*]] = llvm.mlir.constant(1 : i64) : i64
+// CHECK:         %[[VAL_17:.*]] = llvm.mlir.constant(0 : i32) : i32
+// CHECK:         %[[VAL_21:.*]] = llvm.mlir.constant(0 : i64) : i64
+
+// CHECK:         %[[VAL_30:.*]] = llvm.getelementptr %[[VAL_0]]{{\[}}%[[VAL_17]], 0] : (!llvm.ptr<[[struct_t_descriptor:.*]]>, i32) -> !llvm.ptr<ptr<[[struct_t]]>>
+// CHECK:         %[[VAL_31:.*]] = llvm.load %[[VAL_30]] : !llvm.ptr<ptr<[[struct_t]]>>
+// CHECK:         %[[VAL_32:.*]] = llvm.bitcast %[[VAL_31]] : !llvm.ptr<[[struct_t]]> to !llvm.ptr<[[struct_t]]>
+// CHECK:         %[[VAL_33:.*]] = llvm.getelementptr %[[VAL_32]]{{\[}}%[[VAL_21]], 1] : (!llvm.ptr<[[struct_t]]>, i64) -> !llvm.ptr<[[struct_t]]>
+// CHECK:         %[[VAL_34:.*]] = llvm.getelementptr %[[VAL_33]]{{\[}}%[[VAL_4]]] : (!llvm.ptr<[[struct_t]]>, i64) -> !llvm.ptr<[[struct_t]]>
+// CHECK:         llvm.bitcast %[[VAL_34]] : !llvm.ptr<[[struct_t]]> to !llvm.ptr<i8>
+
+// More offset computation with descriptor strides and triplets that is not character specific ...
+
+  %2 = fir.rebox %arg0 [%1] : (!fir.box<!fir.array<?x!fir.type<t{i:i32,c:!fir.char<1,10>}>>>, !fir.slice<1>) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
+  fir.call @bar(%2) : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> ()
+  return
+}

flang/test/Fir/rebox.fir

+// RUN: fir-opt %s | tco | FileCheck %s
+
+// Test applying slice on fir.box
+//   subroutine foo(x)
+//     real :: x(3:, 4:)
+//     call bar(x(5, 6:80:3))
+//   end subroutine
+
+func private @bar1(!fir.box<!fir.array<?xf32>>)
+// CHECK-LABEL: define void @test_rebox_1(
+// CHECK-SAME: { float*, i64, i32, i8, i8, i8, i8, [2 x [3 x i64]] }* %[[INBOX:.*]])
+func @test_rebox_1(%arg0: !fir.box<!fir.array<?x?xf32>>) {
+  // CHECK: %[[OUTBOX_ALLOC:.*]] = alloca { float*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }
+  %c2 = arith.constant 2 : index
+  %c3 = arith.constant 3 : index
+  %c4 = arith.constant 4 : index
+  %c5 = arith.constant 5 : index
+  %c6 = arith.constant 6 : index
+  %c80 = arith.constant 80 : index
+  %undef = fir.undefined index
+  %0 = fir.slice %c5, %undef, %undef, %c6, %c80, %c3 : (index, index, index, index, index, index) -> !fir.slice<2>
+  %1 = fir.shift %c3, %c4 : (index, index) -> !fir.shift<2>
+
+  // CHECK: %[[INSTRIDE_0_GEP:.*]] = getelementptr { float*, i64, i32, i8, i8, i8, i8, [2 x [3 x i64]] }, { float*, i64, i32, i8, i8, i8, i8, [2 x [3 x i64]] }* %[[INBOX]], i32 0, i32 7, i64 0, i32 2
+  // CHECK: %[[INSTRIDE_0:.]] = load i64, i64* %[[INSTRIDE_0_GEP]]
+  // CHECK: %[[INSTRIDE_1_GEP:.*]] = getelementptr { float*, i64, i32, i8, i8, i8, i8, [2 x [3 x i64]] }, { float*, i64, i32, i8, i8, i8, i8, [2 x [3 x i64]] }* %[[INBOX]], i32 0, i32 7, i64 1, i32 2
+  // CHECK: %[[INSTRIDE_1:.*]] = load i64, i64* %[[INSTRIDE_1_GEP]]
+  // CHECK: %[[INBASE_GEP:.*]] = getelementptr { float*, i64, i32, i8, i8, i8, i8, [2 x [3 x i64]] }, { float*, i64, i32, i8, i8, i8, i8, [2 x [3 x i64]] }* %[[INBOX]], i32 0, i32 0
+  // CHECK: %[[INBASE:.*]] = load float*, float** %[[INBASE_GEP]]
+  // CHECK: %[[VOIDBASE:.*]] = bitcast float* %[[INBASE]] to i8*
+  // CHECK: %[[OFFSET_0:.*]] = mul i64 2, %[[INSTRIDE_0]]
+  // CHECK: %[[VOIDBASE0:.*]] = getelementptr i8, i8* %[[VOIDBASE]], i64 %[[OFFSET_0]]
+  // CHECK: %[[OFFSET_1:.*]] = mul i64 2, %[[INSTRIDE_1]]
+  // CHECK: %[[VOIDBASE1:.*]] = getelementptr i8, i8* %[[VOIDBASE0]], i64 %[[OFFSET_1]]
+  // CHECK: %[[OUTSTRIDE0:.*]] = mul i64 3, %[[INSTRIDE_1]]
+  // CHECK: %[[OUTBOX0:.*]] = insertvalue { float*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] } { float* undef, i64 4, i32 {{.*}}, i8 1, i8 27, i8 0, i8 0, [1 x [3 x i64]] [{{.*}} [i64 1, i64 25, i64 undef]] }, i64 %[[OUTSTRIDE0]], 7, 0, 2
+  // CHECK: %[[OUTBASE:.*]] = bitcast i8* %[[VOIDBASE1]] to float*
+  // CHECK: %[[OUTBOX1:.*]] = insertvalue { float*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] } %[[OUTBOX0]], float* %[[OUTBASE]], 0
+  // CHECK: store { float*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] } %[[OUTBOX1]], { float*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }* %[[OUTBOX_ALLOC]], align 8
+  %2 = fir.rebox %arg0(%1) [%0] : (!fir.box<!fir.array<?x?xf32>>, !fir.shift<2>, !fir.slice<2>) -> !fir.box<!fir.array<?xf32>>
+  // CHECK: call void @bar1({ float*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }* %[[OUTBOX_ALLOC]])
+  fir.call @bar1(%2) : (!fir.box<!fir.array<?xf32>>) -> ()
+  return
+}
+
+// Test that character length is propagated in rebox
+//   subroutine foo(x)
+//     character(*) :: x(:, :)
+//     call bar(x(4:30:1, 4:30:1))
+//   end subroutine
+
+func private @bar_rebox_test2(!fir.box<!fir.array<?x?x!fir.char<1,?>>>)
+// CHECK-LABEL: define void @test_rebox_2(
+// CHECK-SAME: { i8*, i64, i32, i8, i8, i8, i8, [2 x [3 x i64]] }* %[[INBOX:.*]])
+func @test_rebox_2(%arg0: !fir.box<!fir.array<?x?x!fir.char<1,?>>>) {
+  %c1 = arith.constant 1 : index
+  %c4 = arith.constant 4 : index
+  %c30 = arith.constant 30 : index
+  %0 = fir.slice %c4, %c30, %c1, %c4, %c30, %c1 : (index, index, index, index, index, index) -> !fir.slice<2>
+  // CHECK: %[[OUTBOX:.*]] = alloca { i8*, i64, i32, i8, i8, i8, i8, [2 x [3 x i64]] }
+  // CHECK: %[[LEN_GEP:.*]] = getelementptr { i8*, i64, i32, i8, i8, i8, i8, [2 x [3 x i64]] }, { i8*, i64, i32, i8, i8, i8, i8, [2 x [3 x i64]] }* %[[INBOX]], i32 0, i32 1
+  // CHECK: %[[LEN:.*]] = load i64, i64* %[[LEN_GEP]]
+  // CHECK: insertvalue { i8*, i64, i32, i8, i8, i8, i8, [2 x [3 x i64]] } undef, i64 %[[LEN]], 1
+
+  %1 = fir.rebox %arg0 [%0]  : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, !fir.slice<2>) -> !fir.box<!fir.array<?x?x!fir.char<1,?>>>
+  fir.call @bar_rebox_test2(%1) : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>) -> ()
+  return
+}
+
+
+// Test setting a new shape on a fir.box
+//   subroutine foo(x)
+//     real :: x(:)
+//     real, pointer(:, :, :), p
+//     p(2:5, 3:7, 4:9) => x
+//     call bar(p)
+//   end subroutine
+
+func private @bar_rebox_test3(!fir.box<!fir.array<?x?x?xf32>>)
+// CHECK-LABEL: define void @test_rebox_3(
+// CHECK-SAME: { float*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }* %[[INBOX:.*]])
+func @test_rebox_3(%arg0: !fir.box<!fir.array<?xf32>>) {
+  // CHECK: %[[OUTBOX_ALLOC:.*]] = alloca { float*, i64, i32, i8, i8, i8, i8, [3 x [3 x i64]] }
+  %c2 = arith.constant 2 : index
+  %c3 = arith.constant 3 : index
+  %c4 = arith.constant 4 : index
+  %c5 = arith.constant 5 : index
+  %1 = fir.shape_shift %c2, %c3, %c3, %c4, %c4, %c5 : (index, index, index, index, index, index) -> !fir.shapeshift<3>
+  // CHECK: %[[INSTRIDE_GEP:.*]] = getelementptr { float*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }, { float*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }* %[[INBOX]], i32 0, i32 7, i64 0, i32 2
+  // CHECK: %[[INSTRIDE:.*]] = load i64, i64* %[[INSTRIDE_GEP]]
+  // CHECK: %[[INBASE_GEP:.*]] = getelementptr { float*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }, { float*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }* %[[INBOX]], i32 0, i32 0
+  // CHECK: %[[INBASE:.*]] = load float*, float** %[[INBASE_GEP]]
+  // CHECK: %[[VOIDBASE:.*]] = bitcast float* %[[INBASE]] to i8*
+  // CHECK: %[[OUTSTRIDE1:.*]] = mul i64 3, %[[INSTRIDE]]
+  // CHECK: %[[OUTSTRIDE2:.*]] = mul i64 4, %[[OUTSTRIDE1]]
+  // CHECK: %[[OUTBOX0:.*]] = insertvalue { float*, i64, i32, i8, i8, i8, i8, [3 x [3 x i64]] } { float* undef, i64 4, i32 {{.*}}, i8 3, i8 27, i8 0, i8 0, [3 x [3 x i64]] [{{.*}} [i64 2, i64 3, i64 undef], [3 x i64] undef, [3 x i64] undef] }, i64 %[[INSTRIDE]], 7, 0, 2
+  // CHECK: %[[OUTBOX1:.*]] = insertvalue { float*, i64, i32, i8, i8, i8, i8, [3 x [3 x i64]] } %[[OUTBOX0]], i64 3, 7, 1, 0
+  // CHECK: %[[OUTBOX2:.*]] = insertvalue { float*, i64, i32, i8, i8, i8, i8, [3 x [3 x i64]] } %[[OUTBOX1]], i64 4, 7, 1, 1
+  // CHECK: %[[OUTBOX3:.*]] = insertvalue { float*, i64, i32, i8, i8, i8, i8, [3 x [3 x i64]] } %[[OUTBOX2]], i64 %[[OUTSTRIDE1]], 7, 1, 2
+  // CHECK: %[[OUTBOX4:.*]] = insertvalue { float*, i64, i32, i8, i8, i8, i8, [3 x [3 x i64]] } %[[OUTBOX3]], i64 4, 7, 2, 0
+  // CHECK: %[[OUTBOX5:.*]] = insertvalue { float*, i64, i32, i8, i8, i8, i8, [3 x [3 x i64]] } %[[OUTBOX4]], i64 5, 7, 2, 1
+  // CHECK: %[[OUTBOX6:.*]] = insertvalue { float*, i64, i32, i8, i8, i8, i8, [3 x [3 x i64]] } %[[OUTBOX5]], i64 %[[OUTSTRIDE2]], 7, 2, 2
+  // CHECK: %[[OUTBASE:.*]] = bitcast i8* %[[VOIDBASE]] to float*
+  // CHECK: %[[OUTBOX7:.*]] = insertvalue { float*, i64, i32, i8, i8, i8, i8, [3 x [3 x i64]] } %[[OUTBOX6]], float* %[[OUTBASE]], 0
+  // CHECK: store { float*, i64, i32, i8, i8, i8, i8, [3 x [3 x i64]] } %[[OUTBOX7]], { float*, i64, i32, i8, i8, i8, i8, [3 x [3 x i64]] }* %[[OUTBOX_ALLOC]]
+  %2 = fir.rebox %arg0(%1) : (!fir.box<!fir.array<?xf32>>, !fir.shapeshift<3>) -> !fir.box<!fir.array<?x?x?xf32>>
+  // CHECK: call void @bar_rebox_test3({ float*, i64, i32, i8, i8, i8, i8, [3 x [3 x i64]] }* %[[OUTBOX_ALLOC]])
+  fir.call @bar_rebox_test3(%2) : (!fir.box<!fir.array<?x?x?xf32>>) -> ()
+  return
+}
+
+
+// Test reboxing of character entities where the input has dynamic length and the output has compile
+// time constant length.
+
+// CHECK-LABEL: define void @test_rebox_4(
+// CHECK-SAME: { i8*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }* %[[INPUT:.*]])
+func @test_rebox_4(%arg0: !fir.box<!fir.array<?x!fir.char<1,?>>>) {
+  // CHECK: %[[NEWBOX_STORAGE:.*]] = alloca { [10 x i8]*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }
+  // CHECK: %[[EXTENT_GEP:.*]] = getelementptr {{{.*}}}, { i8*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }* %[[INPUT]], i32 0, i32 7, i64 0, i32 1
+  // CHECK: %[[EXTENT:.*]] = load i64, i64* %[[EXTENT_GEP]]
+  // CHECK: %[[STRIDE_GEP:.*]] = getelementptr { i8*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }, { i8*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }* %[[INPUT]], i32 0, i32 7, i64 0, i32 2
+  // CHECK: %[[STRIDE:.*]] = load i64, i64* %[[STRIDE_GEP]]
+  // CHECK: %[[BASE_GEP:.*]] = getelementptr { i8*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }, { i8*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }* %[[INPUT]], i32 0, i32 0
+  // CHECK: %[[BASE:.*]] = load i8*, i8** %[[BASE_GEP]]
+  // CHECK: %[[NEWBOX1:.*]] = insertvalue {{{.*}}} { [10 x i8]* undef, i64 10, i32 20180515, i8 1, i8 40, i8 1, i8 0, [1 x [3 x i64]] [{{.*}} [i64 1, i64 undef, i64 undef]] }, i64 %[[EXTENT]], 7, 0, 1
+  // CHECK: %[[NEWBOX2:.*]] = insertvalue { [10 x i8]*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] } %[[NEWBOX1]], i64 %[[STRIDE]], 7, 0, 2
+  // CHECK: %[[BASE_CAST:.*]] = bitcast i8* %12 to [10 x i8]*
+  // CHECK: %[[NEWBOX3:.*]] = insertvalue { [10 x i8]*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] } %[[NEWBOX2]], [10 x i8]* %[[BASE_CAST]], 0
+  // CHECK: store { [10 x i8]*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] } %[[NEWBOX3]], { [10 x i8]*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }* %[[NEWBOX_STORAGE]]
+  // CHECK: call void @bar_test_rebox_4({ [10 x i8]*, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]] }* %[[NEWBOX_STORAGE]])
+
+  %1 = fir.rebox %arg0 : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>
+  fir.call @bar_test_rebox_4(%1) : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>) -> ()
+  return
+}
+func private @bar_test_rebox_4(!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>)