[flang-commits] [flang] 01e8e50 - [flang] Restore declared type when deallocating polymorphic entities
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Thu Jan 12 02:12:37 PST 2023
Author: Valentin Clement
Date: 2023-01-12T11:12:30+01:00
New Revision: 01e8e50ce397dcb08e7dfadab93a53ae31174c67
URL: https://github.com/llvm/llvm-project/commit/01e8e50ce397dcb08e7dfadab93a53ae31174c67
DIFF: https://github.com/llvm/llvm-project/commit/01e8e50ce397dcb08e7dfadab93a53ae31174c67.diff
LOG: [flang] Restore declared type when deallocating polymorphic entities
As mentioned in section 7.3.2.3 note 7, The dynamic type of an unallocated
allocatable object or a disassociated pointer is the same as its declared type.
This patch adds two function to the runtime:
- `PointerDeallocatePolymorphic`
- `AllocatableDeallocatePolymorphic`
These two functions take a DerivedTypeDesc pointer of the declared type.
The lowering is updated accordingly to call these functions for polymorphic
and unlimited polyrmophic entities. For unlimited polymorphic entities, the
dynamic type is set to nullptr when the entity is on an unallocated or
disassociated state.
Reviewed By: PeteSteinfeld, klausler
Differential Revision: https://reviews.llvm.org/D141519
Added:
Modified:
flang/include/flang/Lower/Allocatable.h
flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
flang/include/flang/Runtime/allocatable.h
flang/include/flang/Runtime/pointer.h
flang/lib/Lower/Allocatable.cpp
flang/lib/Lower/ConvertVariable.cpp
flang/runtime/allocatable.cpp
flang/runtime/pointer.cpp
flang/test/Lower/allocatable-polymorphic.f90
flang/test/Lower/intentout-deallocate.f90
flang/test/Lower/polymorphic-types.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/Allocatable.h b/flang/include/flang/Lower/Allocatable.h
index 2da24dcadee76..e839f047449fc 100644
--- a/flang/include/flang/Lower/Allocatable.h
+++ b/flang/include/flang/Lower/Allocatable.h
@@ -35,6 +35,7 @@ struct DeallocateStmt;
namespace semantics {
class Symbol;
+class DerivedTypeSpec;
} // namespace semantics
namespace lower {
@@ -53,7 +54,8 @@ void genDeallocateStmt(AbstractConverter &converter,
const parser::DeallocateStmt &stmt, mlir::Location loc);
void genDeallocateBox(AbstractConverter &converter,
- const fir::MutableBoxValue &box, mlir::Location loc);
+ const fir::MutableBoxValue &box, mlir::Location loc,
+ mlir::Value declaredTypeDesc = {});
/// Create a MutableBoxValue for an allocatable or pointer entity.
/// If the variables is a local variable that is not a dummy, it will be
@@ -85,6 +87,11 @@ mlir::Value getAssumedCharAllocatableOrPointerLen(
fir::FirOpBuilder &builder, mlir::Location loc,
const Fortran::semantics::Symbol &sym, mlir::Value box);
+/// Retrieve the address of a type descriptor from its derived type spec.
+mlir::Value
+getTypeDescAddr(fir::FirOpBuilder &builder, mlir::Location loc,
+ const Fortran::semantics::DerivedTypeSpec &typeSpec);
+
} // namespace lower
} // namespace Fortran
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
index 3a21479a1cfe2..e72ef22ea6afc 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
@@ -290,6 +290,13 @@ getModel<const Fortran::runtime::typeInfo::DerivedType &>() {
};
}
template <>
+constexpr TypeBuilderFunc
+getModel<const Fortran::runtime::typeInfo::DerivedType *>() {
+ return [](mlir::MLIRContext *context) -> mlir::Type {
+ return fir::ReferenceType::get(mlir::NoneType::get(context));
+ };
+}
+template <>
constexpr TypeBuilderFunc getModel<void>() {
return [](mlir::MLIRContext *context) -> mlir::Type {
return mlir::NoneType::get(context);
diff --git a/flang/include/flang/Runtime/allocatable.h b/flang/include/flang/Runtime/allocatable.h
index cce803534d684..f0eb8854a3096 100644
--- a/flang/include/flang/Runtime/allocatable.h
+++ b/flang/include/flang/Runtime/allocatable.h
@@ -104,6 +104,13 @@ int RTNAME(AllocatableDeallocate)(Descriptor &, bool hasStat = false,
const Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
int sourceLine = 0);
+// Same as AllocatableDeallocate but also set the dynamic type as the declared
+// type as mentioned in 7.3.2.3 note 7.
+int RTNAME(AllocatableDeallocatePolymorphic)(Descriptor &,
+ const typeInfo::DerivedType *, bool hasStat = false,
+ const Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
+ int sourceLine = 0);
+
// Variant of above that does not finalize; for intermediate results
void RTNAME(AllocatableDeallocateNoFinal)(
Descriptor &, const char *sourceFile = nullptr, int sourceLine = 0);
diff --git a/flang/include/flang/Runtime/pointer.h b/flang/include/flang/Runtime/pointer.h
index 5bb86dbf49546..69ca357c42f59 100644
--- a/flang/include/flang/Runtime/pointer.h
+++ b/flang/include/flang/Runtime/pointer.h
@@ -91,13 +91,20 @@ int RTNAME(PointerAllocateSource)(Descriptor &, const Descriptor &source,
// Deallocates a data pointer, which must have been allocated by
// PointerAllocate(), possibly copied with PointerAssociate().
-// Finalizes elements &/or components as needed. The pointer is left
+// Finalizes elements &/or components as needed. The pointer is left
// in an initialized disassociated state suitable for reallocation
// with the same bounds, cobounds, and length type parameters.
int RTNAME(PointerDeallocate)(Descriptor &, bool hasStat = false,
const Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
int sourceLine = 0);
+// Same as PointerDeallocate but also set the dynamic type as the declared type
+// as mentioned in 7.3.2.3 note 7.
+int RTNAME(PointerDeallocatePolymorphic)(Descriptor &,
+ const typeInfo::DerivedType *, bool hasStat = false,
+ const Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
+ int sourceLine = 0);
+
// Association inquiries for ASSOCIATED()
// True when the pointer is not disassociated.
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index eb367dfbb68f5..c37448814fabb 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -187,21 +187,36 @@ static mlir::Value genRuntimeAllocate(fir::FirOpBuilder &builder,
static mlir::Value genRuntimeDeallocate(fir::FirOpBuilder &builder,
mlir::Location loc,
const fir::MutableBoxValue &box,
- ErrorManager &errorManager) {
+ ErrorManager &errorManager,
+ mlir::Value declaredTypeDesc = {}) {
// Ensure fir.box is up-to-date before passing it to deallocate runtime.
mlir::Value boxAddress = fir::factory::getMutableIRBox(builder, loc, box);
- mlir::func::FuncOp callee =
- box.isPointer()
- ? fir::runtime::getRuntimeFunc<mkRTKey(PointerDeallocate)>(loc,
- builder)
- : fir::runtime::getRuntimeFunc<mkRTKey(AllocatableDeallocate)>(
- loc, builder);
- llvm::SmallVector<mlir::Value> args{
- boxAddress, errorManager.hasStat, errorManager.errMsgAddr,
- errorManager.sourceFile, errorManager.sourceLine};
+ mlir::func::FuncOp callee;
+ llvm::SmallVector<mlir::Value> args;
llvm::SmallVector<mlir::Value> operands;
- for (auto [fst, snd] : llvm::zip(args, callee.getFunctionType().getInputs()))
- operands.emplace_back(builder.createConvert(loc, snd, fst));
+ if (box.isPolymorphic() || box.isUnlimitedPolymorphic()) {
+ callee = box.isPointer()
+ ? fir::runtime::getRuntimeFunc<mkRTKey(
+ PointerDeallocatePolymorphic)>(loc, builder)
+ : fir::runtime::getRuntimeFunc<mkRTKey(
+ AllocatableDeallocatePolymorphic)>(loc, builder);
+ if (!declaredTypeDesc)
+ declaredTypeDesc = builder.createNullConstant(loc);
+ operands = fir::runtime::createArguments(
+ builder, loc, callee.getFunctionType(), boxAddress, declaredTypeDesc,
+ errorManager.hasStat, errorManager.errMsgAddr, errorManager.sourceFile,
+ errorManager.sourceLine);
+ } else {
+ callee = box.isPointer()
+ ? fir::runtime::getRuntimeFunc<mkRTKey(PointerDeallocate)>(
+ loc, builder)
+ : fir::runtime::getRuntimeFunc<mkRTKey(AllocatableDeallocate)>(
+ loc, builder);
+ operands = fir::runtime::createArguments(
+ builder, loc, callee.getFunctionType(), boxAddress,
+ errorManager.hasStat, errorManager.errMsgAddr, errorManager.sourceFile,
+ errorManager.sourceLine);
+ }
return builder.create<fir::CallOp>(loc, callee, operands).getResult(0);
}
@@ -519,19 +534,8 @@ class AllocateStmtHelper {
if (!typeSpec->AsDerived())
return;
- // Set up descriptor for allocation with derived type spec.
- std::string typeName =
- Fortran::lower::mangle::mangleName(typeSpec->derivedTypeSpec());
- std::string typeDescName =
- fir::NameUniquer::getTypeDescriptorName(typeName);
-
- auto typeDescGlobal =
- builder.getModule().lookupSymbol<fir::GlobalOp>(typeDescName);
- if (!typeDescGlobal)
- fir::emitFatalError(loc, "type descriptor not defined");
- auto typeDescAddr = builder.create<fir::AddrOfOp>(
- loc, fir::ReferenceType::get(typeDescGlobal.getType()),
- typeDescGlobal.getSymbol());
+ auto typeDescAddr = Fortran::lower::getTypeDescAddr(
+ builder, loc, typeSpec->derivedTypeSpec());
mlir::func::FuncOp callee =
box.isPointer()
? fir::runtime::getRuntimeFunc<mkRTKey(PointerNullifyDerived)>(
@@ -590,7 +594,8 @@ void Fortran::lower::genAllocateStmt(
// Generate deallocation of a pointer/allocatable.
static void genDeallocate(fir::FirOpBuilder &builder, mlir::Location loc,
const fir::MutableBoxValue &box,
- ErrorManager &errorManager) {
+ ErrorManager &errorManager,
+ mlir::Value declaredTypeDesc = {}) {
// Deallocate intrinsic types inline.
if (!box.isDerived() && !box.isPolymorphic() &&
!box.isUnlimitedPolymorphic() && !errorManager.hasStatSpec() &&
@@ -601,20 +606,22 @@ static void genDeallocate(fir::FirOpBuilder &builder, mlir::Location loc,
// Use runtime calls to deallocate descriptor cases. Sync MutableBoxValue
// with its descriptor before and after calls if needed.
errorManager.genStatCheck(builder, loc);
- mlir::Value stat = genRuntimeDeallocate(builder, loc, box, errorManager);
+ mlir::Value stat =
+ genRuntimeDeallocate(builder, loc, box, errorManager, declaredTypeDesc);
fir::factory::syncMutableBoxFromIRBox(builder, loc, box);
errorManager.assignStat(builder, loc, stat);
}
void Fortran::lower::genDeallocateBox(
Fortran::lower::AbstractConverter &converter,
- const fir::MutableBoxValue &box, mlir::Location loc) {
+ const fir::MutableBoxValue &box, mlir::Location loc,
+ mlir::Value declaredTypeDesc) {
const Fortran::lower::SomeExpr *statExpr = nullptr;
const Fortran::lower::SomeExpr *errMsgExpr = nullptr;
ErrorManager errorManager;
errorManager.init(converter, loc, statExpr, errMsgExpr);
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
- genDeallocate(builder, loc, box, errorManager);
+ genDeallocate(builder, loc, box, errorManager, declaredTypeDesc);
}
void Fortran::lower::genDeallocateStmt(
@@ -641,7 +648,18 @@ void Fortran::lower::genDeallocateStmt(
std::get<std::list<Fortran::parser::AllocateObject>>(stmt.t)) {
fir::MutableBoxValue box =
genMutableBoxValue(converter, loc, allocateObject);
- genDeallocate(builder, loc, box, errorManager);
+
+ mlir::Value declaredTypeDesc = {};
+ if (box.isPolymorphic()) {
+ const Fortran::semantics::Symbol &symbol = unwrapSymbol(allocateObject);
+ assert(symbol.GetType());
+ if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec =
+ symbol.GetType()->AsDerived()) {
+ declaredTypeDesc =
+ Fortran::lower::getTypeDescAddr(builder, loc, *derivedTypeSpec);
+ }
+ }
+ genDeallocate(builder, loc, box, errorManager, declaredTypeDesc);
}
builder.restoreInsertionPoint(insertPt);
}
@@ -855,3 +873,17 @@ mlir::Value Fortran::lower::getAssumedCharAllocatableOrPointerLen(
return readLength();
}
+
+mlir::Value Fortran::lower::getTypeDescAddr(
+ fir::FirOpBuilder &builder, mlir::Location loc,
+ const Fortran::semantics::DerivedTypeSpec &typeSpec) {
+ std::string typeName = Fortran::lower::mangle::mangleName(typeSpec);
+ std::string typeDescName = fir::NameUniquer::getTypeDescriptorName(typeName);
+ auto typeDescGlobal =
+ builder.getModule().lookupSymbol<fir::GlobalOp>(typeDescName);
+ if (!typeDescGlobal)
+ fir::emitFatalError(loc, "type descriptor not defined");
+ return builder.create<fir::AddrOfOp>(
+ loc, fir::ReferenceType::get(typeDescGlobal.getType()),
+ typeDescGlobal.getSymbol());
+}
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 017a8427d7d50..3a6f432b40545 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -35,6 +35,7 @@
#include "flang/Optimizer/HLFIR/HLFIROps.h"
#include "flang/Optimizer/Support/FIRContext.h"
#include "flang/Optimizer/Support/FatalError.h"
+#include "flang/Optimizer/Support/InternalNames.h"
#include "flang/Semantics/runtime-type-info.h"
#include "flang/Semantics/tools.h"
#include "llvm/Support/Debug.h"
@@ -662,7 +663,20 @@ static void deallocateIntentOut(Fortran::lower::AbstractConverter &converter,
mlir::Value isAlloc = fir::factory::genIsAllocatedOrAssociatedTest(
builder, loc, *mutBox);
builder.genIfThen(loc, isAlloc)
- .genThen([&]() { genDeallocateBox(converter, *mutBox, loc); })
+ .genThen([&]() {
+ if (mutBox->isPolymorphic()) {
+ mlir::Value declaredTypeDesc;
+ assert(sym.GetType());
+ if (const Fortran::semantics::DerivedTypeSpec
+ *derivedTypeSpec = sym.GetType()->AsDerived()) {
+ declaredTypeDesc = Fortran::lower::getTypeDescAddr(
+ builder, loc, *derivedTypeSpec);
+ }
+ genDeallocateBox(converter, *mutBox, loc, declaredTypeDesc);
+ } else {
+ genDeallocateBox(converter, *mutBox, loc);
+ }
+ })
.end();
} else {
genDeallocateBox(converter, *mutBox, loc);
diff --git a/flang/runtime/allocatable.cpp b/flang/runtime/allocatable.cpp
index e0ffd5bf9b24b..99790692aa457 100644
--- a/flang/runtime/allocatable.cpp
+++ b/flang/runtime/allocatable.cpp
@@ -100,6 +100,19 @@ int RTNAME(AllocatableDeallocate)(Descriptor &descriptor, bool hasStat,
return ReturnError(terminator, descriptor.Destroy(true), errMsg, hasStat);
}
+int RTNAME(AllocatableDeallocatePolymorphic)(Descriptor &descriptor,
+ const typeInfo::DerivedType *derivedType, bool hasStat,
+ const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
+ int stat{RTNAME(AllocatableDeallocate)(
+ descriptor, hasStat, errMsg, sourceFile, sourceLine)};
+ if (stat == StatOk) {
+ DescriptorAddendum *addendum{descriptor.Addendum()};
+ INTERNAL_CHECK(addendum != nullptr);
+ addendum->set_derivedType(derivedType);
+ }
+ return stat;
+}
+
void RTNAME(AllocatableDeallocateNoFinal)(
Descriptor &descriptor, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
diff --git a/flang/runtime/pointer.cpp b/flang/runtime/pointer.cpp
index 1ce913940263e..408f6ac5cc71e 100644
--- a/flang/runtime/pointer.cpp
+++ b/flang/runtime/pointer.cpp
@@ -144,6 +144,19 @@ int RTNAME(PointerDeallocate)(Descriptor &pointer, bool hasStat,
return ReturnError(terminator, pointer.Destroy(true, true), errMsg, hasStat);
}
+int RTNAME(PointerDeallocatePolymorphic)(Descriptor &pointer,
+ const typeInfo::DerivedType *derivedType, bool hasStat,
+ const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
+ int stat{RTNAME(PointerDeallocate)(
+ pointer, hasStat, errMsg, sourceFile, sourceLine)};
+ if (stat == StatOk) {
+ DescriptorAddendum *addendum{pointer.Addendum()};
+ INTERNAL_CHECK(addendum != nullptr);
+ addendum->set_derivedType(derivedType);
+ }
+ return stat;
+}
+
bool RTNAME(PointerIsAssociated)(const Descriptor &pointer) {
return pointer.raw().base_addr != nullptr;
}
diff --git a/flang/test/Lower/allocatable-polymorphic.f90 b/flang/test/Lower/allocatable-polymorphic.f90
index d8e849248fbb2..968de1e4b12a6 100644
--- a/flang/test/Lower/allocatable-polymorphic.f90
+++ b/flang/test/Lower/allocatable-polymorphic.f90
@@ -178,20 +178,31 @@ subroutine test_pointer()
! CHECK: %[[C4_BOXED:.*]] = fir.embox %[[C4_COORD]] tdesc %[[C4_TDESC]] : (!fir.ref<!fir.type<_QMpolyTp1{a:i32,b:i32}>>, !fir.tdesc<none>) -> !fir.class<!fir.type<_QMpolyTp1{a:i32,b:i32}>>
! CHECK: fir.dispatch "proc2"(%[[C4_BOXED]] : !fir.class<!fir.type<_QMpolyTp1{a:i32,b:i32}>>) (%[[C4_BOXED]] : !fir.class<!fir.type<_QMpolyTp1{a:i32,b:i32}>>) {pass_arg_pos = 0 : i32}
+
+! CHECK: %[[TYPE_DESC_ADDR:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
! CHECK: %[[P_CAST:.*]] = fir.convert %[[P_DESC]] : (!fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %{{.*}} = fir.call @_FortranAPointerDeallocate(%[[P_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_NONE:.*]] = fir.convert %[[TYPE_DESC_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
+! CHECK: %{{.*}} = fir.call @_FortranAPointerDeallocatePolymorphic(%[[P_CAST]], %[[TYPE_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_DESC_ADDR:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
! CHECK: %[[C1_DESC_CAST:.*]] = fir.convert %[[C1_DESC]] : (!fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %{{.*}} = fir.call @_FortranAPointerDeallocate(%[[C1_DESC_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_NONE:.*]] = fir.convert %[[TYPE_DESC_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
+! CHECK: %{{.*}} = fir.call @_FortranAPointerDeallocatePolymorphic(%[[C1_DESC_CAST]], %[[TYPE_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_DESC_ADDR:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
! CHECK: %[[C2_DESC_CAST:.*]] = fir.convert %[[C2_DESC]] : (!fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %{{.*}} = fir.call @_FortranAPointerDeallocate(%[[C2_DESC_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_NONE:.*]] = fir.convert %[[TYPE_DESC_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
+! CHECK: %{{.*}} = fir.call @_FortranAPointerDeallocatePolymorphic(%[[C2_DESC_CAST]], %[[TYPE_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_DESC_ADDR:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
! CHECK: %[[C3_DESC_CAST:.*]] = fir.convert %[[C3_DESC]] : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %{{.*}} = fir.call @_FortranAPointerDeallocate(%[[C3_DESC_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_NONE:.*]] = fir.convert %[[TYPE_DESC_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
+! CHECK: %{{.*}} = fir.call @_FortranAPointerDeallocatePolymorphic(%[[C3_DESC_CAST]], %[[TYPE_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_DESC_ADDR:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
! CHECK: %[[C4_DESC_CAST:.*]] = fir.convert %[[C4_DESC]] : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %{{.*}} = fir.call @_FortranAPointerDeallocate(%[[C4_DESC_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_NONE:.*]] = fir.convert %[[TYPE_DESC_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
+! CHECK: %{{.*}} = fir.call @_FortranAPointerDeallocatePolymorphic(%[[C4_DESC_CAST]], %[[TYPE_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! ------------------------------------------------------------------------------
! Test lowering of ALLOCATE statement for polymoprhic allocatable
@@ -330,20 +341,30 @@ subroutine test_allocatable()
! CHECK: %[[C4_EMBOX:.*]] = fir.embox %[[C4_COORD]] tdesc %[[C4_TDESC]] : (!fir.ref<!fir.type<_QMpolyTp1{a:i32,b:i32}>>, !fir.tdesc<none>) -> !fir.class<!fir.type<_QMpolyTp1{a:i32,b:i32}>>
! CHECK: fir.dispatch "proc2"(%[[C4_EMBOX]] : !fir.class<!fir.type<_QMpolyTp1{a:i32,b:i32}>>) (%[[C4_EMBOX]] : !fir.class<!fir.type<_QMpolyTp1{a:i32,b:i32}>>) {pass_arg_pos = 0 : i32}
+! CHECK: %[[TYPE_DESC_ADDR:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
! CHECK: %[[P_CAST:.*]] = fir.convert %[[P]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[P_CAST]], %{{.*}}, %{{.*}}, %1{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_NONE:.*]] = fir.convert %[[TYPE_DESC_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocatePolymorphic(%[[P_CAST]], %[[TYPE_NONE]], %{{.*}}, %1{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_DESC_ADDR:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
! CHECK: %[[C1_CAST:.*]] = fir.convert %[[C1]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[C1_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_NONE:.*]] = fir.convert %[[TYPE_DESC_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocatePolymorphic(%[[C1_CAST]], %[[TYPE_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_DESC_ADDR:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
! CHECK: %[[C2_CAST:.*]] = fir.convert %[[C2]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[C2_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_NONE:.*]] = fir.convert %[[TYPE_DESC_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocatePolymorphic(%[[C2_CAST]], %[[TYPE_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_DESC_ADDR:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
! CHECK: %[[C3_CAST:.*]] = fir.convert %[[C3]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[C3_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_NONE:.*]] = fir.convert %[[TYPE_DESC_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocatePolymorphic(%[[C3_CAST]], %[[TYPE_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_DESC_ADDR:.*]] = fir.address_of(@_QMpolyE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
! CHECK: %[[C4_CAST:.*]] = fir.convert %[[C4]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[C4_CAST]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_NONE:.*]] = fir.convert %[[TYPE_DESC_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocatePolymorphic(%[[C4_CAST]], %[[TYPE_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
subroutine test_unlimited_polymorphic_with_intrinsic_type_spec()
class(*), allocatable :: p
@@ -377,6 +398,10 @@ subroutine test_unlimited_polymorphic_with_intrinsic_type_spec()
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[PTR]] : (!fir.ref<!fir.class<!fir.ptr<none>>>) -> !fir.ref<!fir.box<none>>
! CHECK: %{{.*}} = fir.call @_FortranAPointerAllocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[NULL_TYPE_DESC:.*]] = fir.zero_bits !fir.ref<none>
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[PTR]] : (!fir.ref<!fir.class<!fir.ptr<none>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %{{.*}} = fir.call @_FortranAPointerDeallocatePolymorphic(%[[BOX_NONE]], %[[NULL_TYPE_DESC]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
! Test code generation of deallocate
subroutine test_deallocate()
class(p1), allocatable :: p
@@ -494,4 +519,4 @@ program test_alloc
! LLVM: store { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %[[LOAD]], ptr %[[ALLOCA2]]
! LLVM: %{{.*}} = call {} @_FortranAAllocatableInitDerived(ptr %[[ALLOCA2]], ptr @_QMpolyE.dt.p1, i32 0, i32 0)
! LLVM: %{{.*}} = call i32 @_FortranAAllocatableAllocate(ptr %[[ALLOCA2]], i1 false, ptr null, ptr @_QQcl.{{.*}}, i32 {{.*}})
-! LLVM: %{{.*}} = call i32 @_FortranAAllocatableDeallocate(ptr %[[ALLOCA2]], i1 false, ptr null, ptr @_QQcl.{{.*}}, i32 {{.*}})
+! LLVM: %{{.*}} = call i32 @_FortranAAllocatableDeallocatePolymorphic(ptr %[[ALLOCA2]], ptr {{.*}}, i1 false, ptr null, ptr @_QQcl.{{.*}}, i32 {{.*}})
diff --git a/flang/test/Lower/intentout-deallocate.f90 b/flang/test/Lower/intentout-deallocate.f90
index c0a5e1c6505c3..52ba5fa3b381f 100644
--- a/flang/test/Lower/intentout-deallocate.f90
+++ b/flang/test/Lower/intentout-deallocate.f90
@@ -215,8 +215,10 @@ subroutine sub14(p)
! CHECK: %[[C0:.*]] = arith.constant 0 : i64
! CHECK: %[[IS_ALLOCATED:.*]] = arith.cmpi ne, %[[BOX_ADDR_PTR]], %[[C0]] : i64
! CHECK: fir.if %[[IS_ALLOCATED]] {
+! CHECK: %[[TYPE_DESC_ADDR:.*]] = fir.address_of(@_QMmod1E.dt.t) : !fir.ref<!fir.type<{{.*}}>>
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[TYPE_NONE:.*]] = fir.convert %9 : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocatePolymorphic(%[[BOX_NONE]], %[[TYPE_NONE]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK: }
subroutine sub15(p)
@@ -231,8 +233,9 @@ subroutine sub15(p)
! CHECK: %[[C0:.*]] = arith.constant 0 : i64
! CHECK: %[[IS_ALLOCATED:.*]] = arith.cmpi ne, %[[BOX_ADDR_PTR]], %[[C0]] : i64
! CHECK: fir.if %[[IS_ALLOCATED]] {
+! CHECK: %[[NULL_TYPE_DESC:.*]] = fir.zero_bits !fir.ref<none>
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<none>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocatePolymorphic(%[[BOX_NONE]], %[[NULL_TYPE_DESC]], %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK: }
end module
diff --git a/flang/test/Lower/polymorphic-types.f90 b/flang/test/Lower/polymorphic-types.f90
index 6fea4df7f3f78..62ddff090354d 100644
--- a/flang/test/Lower/polymorphic-types.f90
+++ b/flang/test/Lower/polymorphic-types.f90
@@ -57,7 +57,7 @@ subroutine polymorphic_allocatable_intentout(p)
! CHECK-LABEL: func.func @_QMpolymorphic_typesPpolymorphic_allocatable_intentout(
! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>>
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocatePolymorphic(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! ------------------------------------------------------------------------------
! Test unlimited polymorphic dummy argument types
@@ -105,7 +105,7 @@ subroutine unlimited_polymorphic_allocatable_intentout(p)
! CHECK-LABEL: func.func @_QMpolymorphic_typesPunlimited_polymorphic_allocatable_intentout(
! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.heap<none>>>
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<none>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocatePolymorphic(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! ------------------------------------------------------------------------------
! Test polymorphic function return types
More information about the flang-commits
mailing list