diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp index d944a4c98473e..8c4e12913f714 100644 --- a/flang/lib/Optimizer/Builder/MutableBox.cpp +++ b/flang/lib/Optimizer/Builder/MutableBox.cpp @@ -987,6 +987,15 @@ mlir::Value fir::factory::getAndEstablishBoxStorage( mlir::Value boxStorage = builder.createTemporary(loc, boxTy); mlir::Value nullAddr = builder.createNullConstant(loc, boxTy.getBaseAddressType()); + if (polymorphicMold && fir::isAssumedType(polymorphicMold.getType())) { + // An assumed-type (!fir.box) entity cannot be used as a mold + // in fir.embox, so we have to represent it as an unlimited + // polymorphic entity (!fir.class). + mlir::Type newMoldType = fir::wrapInClassOrBoxType( + mlir::cast(polymorphicMold.getType()).getEleTy(), + /*isPolymorphic=*/true); + polymorphicMold = builder.createConvert(loc, newMoldType, polymorphicMold); + } mlir::Value box = builder.create(loc, boxTy, nullAddr, shape, /*emptySlice=*/mlir::Value{}, diff --git a/flang/test/Transforms/lower-repack-arrays.fir b/flang/test/Transforms/lower-repack-arrays.fir index 458869cce45fd..07bc5eefff427 100644 --- a/flang/test/Transforms/lower-repack-arrays.fir +++ b/flang/test/Transforms/lower-repack-arrays.fir @@ -1091,3 +1091,81 @@ func.func @_QPtest7_stack(%arg0: !fir.class> {fir.bindc_nam // CHECK: } // CHECK: return // CHECK: } + +// Test assumed type array. +// The temporary allocation requires creating a fir.box with the mold +// being the !fir.box>. We have to cast it to +// !fir.class> to make the fir.embox's source_box +// operand valid. +// CHECK-LABEL: func.func @_QPrepack_assumed_type( +// CHECK-SAME: %[[ARG0:.*]]: !fir.box> {fir.bindc_name = "x"}) { +// CHECK: %[[VAL_0:.*]] = arith.constant +// CHECK: %[[VAL_1:.*]] = arith.constant +// CHECK: %[[VAL_2:.*]] = arith.constant 0 : index +// CHECK: %[[VAL_3:.*]] = arith.constant false +// CHECK: %[[VAL_4:.*]] = fir.alloca !fir.class>> +// CHECK: %[[VAL_5:.*]] = fir.dummy_scope : !fir.dscope +// CHECK: %[[VAL_6:.*]] = fir.is_present %[[ARG0]] : (!fir.box>) -> i1 +// CHECK: %[[VAL_7:.*]] = fir.if %[[VAL_6]] -> (!fir.box>) { +// CHECK: %[[VAL_8:.*]] = fir.is_contiguous_box %[[ARG0]] whole : (!fir.box>) -> i1 +// CHECK: %[[VAL_9:.*]] = arith.cmpi eq, %[[VAL_8]], %[[VAL_3]] : i1 +// CHECK: %[[VAL_10:.*]] = fir.box_addr %[[ARG0]] : (!fir.box>) -> !fir.ref>> +// CHECK: %[[VAL_11:.*]] = fir.is_present %[[VAL_10]] : (!fir.ref>>) -> i1 +// CHECK: %[[VAL_12:.*]] = arith.andi %[[VAL_9]], %[[VAL_11]] : i1 +// CHECK: %[[VAL_13:.*]] = fir.if %[[VAL_12]] weights([0, 1]) -> (!fir.box>) { +// CHECK: %[[VAL_14:.*]]:3 = fir.box_dims %[[ARG0]], %[[VAL_2]] : (!fir.box>, index) -> (index, index, index) +// CHECK: %[[VAL_15:.*]] = fir.shape %[[VAL_14]]#1 : (index) -> !fir.shape<1> +// CHECK: %[[VAL_16:.*]] = fir.zero_bits !fir.heap> +// CHECK: %[[VAL_17:.*]] = fir.convert %[[ARG0]] : (!fir.box>) -> !fir.class> +// CHECK: %[[VAL_18:.*]] = fir.embox %[[VAL_16]](%[[VAL_15]]) source_box %[[VAL_17]] : (!fir.heap>, !fir.shape<1>, !fir.class>) -> !fir.class>> +// CHECK: fir.store %[[VAL_18]] to %[[VAL_4]] : !fir.ref>>> +// CHECK: %[[VAL_19:.*]] = fir.zero_bits !fir.ref +// CHECK: %[[VAL_20:.*]] = fir.address_of(@{{_QQcl.*}}) : !fir.ref> +// CHECK: %[[VAL_21:.*]] = fir.absent !fir.box +// CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_4]] : (!fir.ref>>>) -> !fir.ref> +// CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_19]] : (!fir.ref) -> !fir.ref +// CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_20]] : (!fir.ref>) -> !fir.ref +// CHECK: %[[VAL_25:.*]] = fir.call @_FortranAAllocatableAllocate(%[[VAL_22]], %[[VAL_23]], %[[VAL_3]], %[[VAL_21]], %[[VAL_24]], %[[VAL_1]]) : (!fir.ref>, !fir.ref, i1, !fir.box, !fir.ref, i32) -> i32 +// CHECK: %[[VAL_26:.*]] = fir.load %[[VAL_4]] : !fir.ref>>> +// CHECK: %[[VAL_27:.*]] = fir.declare %[[VAL_26]] {uniq_name = ".repacked"} : (!fir.class>>) -> !fir.class>> +// CHECK: %[[VAL_28:.*]] = fir.address_of(@{{_QQcl.*}}) : !fir.ref> +// CHECK: %[[VAL_29:.*]] = fir.convert %[[VAL_27]] : (!fir.class>>) -> !fir.box +// CHECK: %[[VAL_30:.*]] = fir.convert %[[ARG0]] : (!fir.box>) -> !fir.box +// CHECK: %[[VAL_31:.*]] = fir.convert %[[VAL_28]] : (!fir.ref>) -> !fir.ref +// CHECK: fir.call @_FortranAShallowCopyDirect(%[[VAL_29]], %[[VAL_30]], %[[VAL_31]], %[[VAL_1]]) : (!fir.box, !fir.box, !fir.ref, i32) -> () +// CHECK: %[[VAL_32:.*]] = fir.shift %[[VAL_14]]#0 : (index) -> !fir.shift<1> +// CHECK: %[[VAL_33:.*]] = fir.rebox %[[VAL_27]](%[[VAL_32]]) : (!fir.class>>, !fir.shift<1>) -> !fir.box> +// CHECK: fir.result %[[VAL_33]] : !fir.box> +// CHECK: } else { +// CHECK: fir.result %[[ARG0]] : !fir.box> +// CHECK: } +// CHECK: fir.result %[[VAL_13]] : !fir.box> +// CHECK: } else { +// CHECK: fir.result %[[ARG0]] : !fir.box> +// CHECK: } +// CHECK: %[[VAL_34:.*]] = fir.declare %[[VAL_7]] dummy_scope %[[VAL_5]] {uniq_name = "_QFrepack_assumed_typeEx"} : (!fir.box>, !fir.dscope) -> !fir.box> +// CHECK: %[[VAL_35:.*]] = fir.is_present %[[ARG0]] : (!fir.box>) -> i1 +// CHECK: fir.if %[[VAL_35]] { +// CHECK: %[[VAL_36:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box>) -> !fir.heap> +// CHECK: %[[VAL_37:.*]] = fir.box_addr %[[ARG0]] : (!fir.box>) -> !fir.heap> +// CHECK: %[[VAL_38:.*]] = fir.convert %[[VAL_36]] : (!fir.heap>) -> index +// CHECK: %[[VAL_39:.*]] = fir.convert %[[VAL_37]] : (!fir.heap>) -> index +// CHECK: %[[VAL_40:.*]] = arith.cmpi ne, %[[VAL_38]], %[[VAL_39]] : index +// CHECK: fir.if %[[VAL_40]] weights([0, 1]) { +// CHECK: %[[VAL_41:.*]] = fir.address_of(@{{_QQcl.*}}) : !fir.ref> +// CHECK: %[[VAL_42:.*]] = fir.convert %[[ARG0]] : (!fir.box>) -> !fir.box +// CHECK: %[[VAL_43:.*]] = fir.convert %[[VAL_7]] : (!fir.box>) -> !fir.box +// CHECK: %[[VAL_44:.*]] = fir.convert %[[VAL_41]] : (!fir.ref>) -> !fir.ref +// CHECK: fir.call @_FortranAShallowCopyDirect(%[[VAL_42]], %[[VAL_43]], %[[VAL_44]], %[[VAL_0]]) : (!fir.box, !fir.box, !fir.ref, i32) -> () +// CHECK: fir.freemem %[[VAL_36]] : !fir.heap> +// CHECK: } +// CHECK: } +// CHECK: return +// CHECK: } +func.func @_QPrepack_assumed_type(%arg0: !fir.box> {fir.bindc_name = "x"}) { + %0 = fir.dummy_scope : !fir.dscope + %1 = fir.pack_array %arg0 heap whole : (!fir.box>) -> !fir.box> + %2 = fir.declare %1 dummy_scope %0 {uniq_name = "_QFrepack_assumed_typeEx"} : (!fir.box>, !fir.dscope) -> !fir.box> + fir.unpack_array %1 to %arg0 heap : !fir.box> + return +}