// with the other APIs for allocatables.) The destination descriptor
// must be initialized.
std::int32_t RTNAME(MoveAlloc)(Descriptor &to, Descriptor &from,
- bool hasStat = false, const Descriptor *errMsg = nullptr,
- const char *sourceFile = nullptr, int sourceLine = 0);
+ const typeInfo::DerivedType *, bool hasStat = false,
+ const Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
+ int sourceLine = 0);
// Deallocates an allocatable. Finalizes elements &/or components as needed.
// The allocatable is left in an initialized state suitable for reallocation
mlir::FunctionType fTy{func.getFunctionType()};
mlir::Value sourceFile{fir::factory::locationToFilename(builder, loc)};
mlir::Value sourceLine{
- fir::factory::locationToLineNo(builder, loc, fTy.getInput(5))};
+ fir::factory::locationToLineNo(builder, loc, fTy.getInput(6))};
+ mlir::Value declaredTypeDesc;
+ if (fir::isPolymorphicType(from.getType())) {
+ fir::ClassType clTy =
+ fir::dyn_cast_ptrEleTy(from.getType()).dyn_cast<fir::ClassType>();
+ mlir::Type derivedType = fir::unwrapInnerType(clTy.getEleTy());
+ declaredTypeDesc =
+ builder.create<fir::TypeDescOp>(loc, mlir::TypeAttr::get(derivedType));
+ } else {
+ declaredTypeDesc = builder.createNullConstant(loc);
+ }
llvm::SmallVector<mlir::Value> args{fir::runtime::createArguments(
- builder, loc, fTy, to, from, hasStat, errMsg, sourceFile, sourceLine)};
+ builder, loc, fTy, to, from, declaredTypeDesc, hasStat, errMsg,
+ sourceFile, sourceLine)};
return builder.create<fir::CallOp>(loc, func, args).getResult(0);
}
derivedType, nullptr, rank, nullptr, CFI_attribute_allocatable);
}
-std::int32_t RTNAME(MoveAlloc)(Descriptor &to, Descriptor &from, bool hasStat,
+std::int32_t RTNAME(MoveAlloc)(Descriptor &to, Descriptor &from,
+ const typeInfo::DerivedType *derivedType, bool hasStat,
const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
if (from.IsAllocated()) {
to = from;
from.raw().base_addr = nullptr;
+
+ // Carry over the dynamic type.
+ if (auto *toAddendum{to.Addendum()}) {
+ if (const auto *fromAddendum{from.Addendum()}) {
+ if (const auto *derived{fromAddendum->derivedType()}) {
+ toAddendum->set_derivedType(derived);
+ }
+ }
+ }
+
+ // Reset from dynamic type if needed.
+ if (auto *fromAddendum{from.Addendum()}) {
+ if (derivedType) {
+ fromAddendum->set_derivedType(derivedType);
+ }
+ }
}
+
return StatOk;
}
! CHECK-DAG: %[[a2:.*]] = fir.convert %[[a1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
! CHECK-DAG: %[[b2:.*]] = fir.convert %[[b1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
call move_alloc(from, to)
- ! CHECK: fir.call @_FortranAMoveAlloc(%[[b2]], %[[a2]], %[[false]], %[[errMsg]], %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+ ! CHECK: fir.call @_FortranAMoveAlloc(%[[b2]], %[[a2]], %{{.*}}, %[[false]], %[[errMsg]], %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK-DAG: %[[a3:.*]] = fir.load %[[a1:.*]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
! CHECK-DAG: %[[a4:.*]] = fir.box_addr %[[a3]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
! CHECK-DAG: %[[b3:.*]] = fir.load %[[b1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
! CHECK-DAG: %[[a2:.*]] = fir.convert %[[a1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
! CHECK-DAG: %[[b2:.*]] = fir.convert %[[b1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
call move_alloc(from, to, stat)
- ! CHECK: %[[stat:.*]] = fir.call @_FortranAMoveAlloc(%[[b2]], %[[a2]], %[[true]], %[[errMsg]], %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+ ! CHECK: %[[stat:.*]] = fir.call @_FortranAMoveAlloc(%[[b2]], %[[a2]], %{{.*}}, %[[true]], %[[errMsg]], %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK-DAG: %[[a3:.*]] = fir.load %[[a1:.*]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
! CHECK-DAG: %[[a4:.*]] = fir.box_addr %[[a3]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
! CHECK-DAG: %[[b3:.*]] = fir.load %[[b1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
! CHECK-DAG: %[[a2:.*]] = fir.convert %[[a1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
! CHECK-DAG: %[[b2:.*]] = fir.convert %[[b1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
call move_alloc(from, to, stat, errMsg)
- ! CHECK: %[[stat:.*]] = fir.call @_FortranAMoveAlloc(%[[b2]], %[[a2]], %[[true]], %[[errMsg3]], %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+ ! CHECK: %[[stat:.*]] = fir.call @_FortranAMoveAlloc(%[[b2]], %[[a2]], %{{.*}}, %[[true]], %[[errMsg3]], %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK-DAG: %[[a3:.*]] = fir.load %[[a1:.*]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
! CHECK-DAG: %[[a4:.*]] = fir.box_addr %[[a3]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
! CHECK-DAG: %[[b3:.*]] = fir.load %[[b1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
! CHECK: fir.store %[[EMBOX]] to %[[NEW_BOX]] : !fir.ref<!fir.class<!fir.ptr<none>>>
! CHECK: fir.call @_QMpolymorphic_testPup_pointer(%[[NEW_BOX]]) {{.*}} : (!fir.ref<!fir.class<!fir.ptr<none>>>) -> ()
+ subroutine move_alloc_poly(a, b)
+ class(p1), allocatable :: a, b
+
+ call move_alloc(a, b)
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPmove_alloc_poly(
+! CHECK-SAME: %[[A:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {fir.bindc_name = "a"}, %[[B:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {fir.bindc_name = "b"}) {
+! CHECK: %[[TYPE_DESC:.*]] = fir.type_desc !fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>
+! CHECK: %[[B_CONV:.*]] = fir.convert %[[B]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[A_CONV:.*]] = fir.convert %[[A]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[TYPE_DESC_CONV:.*]] = fir.convert %[[TYPE_DESC]] : (!fir.tdesc<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.ref<none>
+! CHECK: %{{.*}} = fir.call @_FortranAMoveAlloc(%[[B_CONV]], %[[A_CONV]], %[[TYPE_DESC_CONV]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
end module
program test
mlir::Value errMsg = firBuilder->create<fir::UndefOp>(loc, seqTy);
mlir::Value hasStat = firBuilder->createBool(loc, false);
fir::runtime::genMoveAlloc(*firBuilder, loc, to, from, hasStat, errMsg);
- checkCallOpFromResultBox(to, "_FortranAMoveAlloc", 4);
+ checkCallOpFromResultBox(to, "_FortranAMoveAlloc", 5);
}
EXPECT_FALSE(b->IsAllocated());
// Simple move_alloc
- RTNAME(MoveAlloc)(*b, *a, false, nullptr, __FILE__, __LINE__);
+ RTNAME(MoveAlloc)(*b, *a, nullptr, false, nullptr, __FILE__, __LINE__);
EXPECT_FALSE(a->IsAllocated());
EXPECT_TRUE(b->IsAllocated());
// move_alloc with stat
std::int32_t stat{
- RTNAME(MoveAlloc)(*a, *b, true, nullptr, __FILE__, __LINE__)};
+ RTNAME(MoveAlloc)(*a, *b, nullptr, true, nullptr, __FILE__, __LINE__)};
EXPECT_TRUE(a->IsAllocated());
EXPECT_FALSE(b->IsAllocated());
EXPECT_EQ(stat, 0);
auto errMsg{Descriptor::Create(
sizeof(char), 64, nullptr, 0, nullptr, CFI_attribute_allocatable)};
errMsg->Allocate();
- RTNAME(MoveAlloc)(*b, *a, false, errMsg.get(), __FILE__, __LINE__);
+ RTNAME(MoveAlloc)(*b, *a, nullptr, false, errMsg.get(), __FILE__, __LINE__);
EXPECT_FALSE(a->IsAllocated());
EXPECT_TRUE(b->IsAllocated());
// move_alloc with stat and errMsg
- stat = RTNAME(MoveAlloc)(*a, *b, true, errMsg.get(), __FILE__, __LINE__);
+ stat = RTNAME(MoveAlloc)(
+ *a, *b, nullptr, true, errMsg.get(), __FILE__, __LINE__);
EXPECT_TRUE(a->IsAllocated());
EXPECT_FALSE(b->IsAllocated());
EXPECT_EQ(stat, 0);
// move_alloc with the same deallocated array
- stat = RTNAME(MoveAlloc)(*b, *b, true, errMsg.get(), __FILE__, __LINE__);
+ stat = RTNAME(MoveAlloc)(
+ *b, *b, nullptr, true, errMsg.get(), __FILE__, __LINE__);
EXPECT_FALSE(b->IsAllocated());
EXPECT_EQ(stat, 0);
// move_alloc with the same allocated array should fail
- stat = RTNAME(MoveAlloc)(*a, *a, true, errMsg.get(), __FILE__, __LINE__);
+ stat = RTNAME(MoveAlloc)(
+ *a, *a, nullptr, true, errMsg.get(), __FILE__, __LINE__);
EXPECT_EQ(stat, 109);
std::string_view errStr{errMsg->OffsetElement(), errMsg->ElementBytes()};
auto trim_pos = errStr.find_last_not_of(' ');