[flang-commits] [flang] 5cc3879 - [flang] Support allocate with source for polymorphic entities
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Tue Jan 17 07:12:54 PST 2023
Author: Valentin Clement
Date: 2023-01-17T16:12:46+01:00
New Revision: 5cc3879e111c696cf635d4278abbec39404b7aed
URL: https://github.com/llvm/llvm-project/commit/5cc3879e111c696cf635d4278abbec39404b7aed
DIFF: https://github.com/llvm/llvm-project/commit/5cc3879e111c696cf635d4278abbec39404b7aed.diff
LOG: [flang] Support allocate with source for polymorphic entities
Apply the source type spec to the descriptor for
polyrmophic entities.
Reviewed By: PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D141822
Added:
Modified:
flang/lib/Lower/Allocatable.cpp
flang/test/Lower/allocatable-polymorphic.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index 73c50271be60..258754463789 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -558,13 +558,30 @@ class AllocateStmtHelper {
genAllocateObjectInit(box);
if (alloc.hasCoarraySpec())
TODO(loc, "coarray allocation");
- if (alloc.type.IsPolymorphic())
- TODO(loc, "polymorphic allocation with SOURCE specifier");
// Set length of the allocate object if it has. Otherwise, get the length
// from source for the deferred length parameter.
if (lenParams.empty() && box.isCharacter() &&
!box.hasNonDeferredLenParams())
lenParams.push_back(fir::factory::readCharLen(builder, loc, sourceExv));
+ if (alloc.type.IsPolymorphic()) {
+ assert(sourceExpr->GetType() && "null type not expected");
+ if (alloc.type.IsUnlimitedPolymorphic() &&
+ sourceExpr->GetType()->IsUnlimitedPolymorphic())
+ TODO(loc, "allocate unlimited polymorphic entity from unlimited "
+ "polymorphic source");
+
+ if (sourceExpr->GetType()->category() == TypeCategory::Derived) {
+ mlir::Type tdescType =
+ fir::TypeDescType::get(mlir::NoneType::get(builder.getContext()));
+ mlir::Value typeDescAddr = builder.create<fir::BoxTypeDescOp>(
+ loc, tdescType, fir::getBase(sourceExv));
+ genInitDerived(box, typeDescAddr, alloc.getSymbol().Rank());
+ } else {
+ genInitIntrinsic(box, sourceExpr->GetType()->category(),
+ sourceExpr->GetType()->kind(),
+ alloc.getSymbol().Rank());
+ }
+ }
genSetDeferredLengthParameters(alloc, box);
genAllocateObjectBounds(alloc, box);
mlir::Value stat =
@@ -582,6 +599,63 @@ class AllocateStmtHelper {
errorManager.assignStat(builder, loc, stat);
}
+ /// Generate call to PointerNullifyDerived or AllocatableInitDerived
+ /// to set the dynamic type information.
+ void genInitDerived(const fir::MutableBoxValue &box, mlir::Value typeDescAddr,
+ int rank, int corank = 0) {
+ mlir::func::FuncOp callee =
+ box.isPointer()
+ ? fir::runtime::getRuntimeFunc<mkRTKey(PointerNullifyDerived)>(
+ loc, builder)
+ : fir::runtime::getRuntimeFunc<mkRTKey(AllocatableInitDerived)>(
+ loc, builder);
+
+ llvm::ArrayRef<mlir::Type> inputTypes =
+ callee.getFunctionType().getInputs();
+ llvm::SmallVector<mlir::Value> args;
+ args.push_back(builder.createConvert(loc, inputTypes[0], box.getAddr()));
+ args.push_back(builder.createConvert(loc, inputTypes[1], typeDescAddr));
+ mlir::Value rankValue =
+ builder.createIntegerConstant(loc, inputTypes[2], rank);
+ mlir::Value corankValue =
+ builder.createIntegerConstant(loc, inputTypes[3], corank);
+ args.push_back(rankValue);
+ args.push_back(corankValue);
+ builder.create<fir::CallOp>(loc, callee, args);
+ }
+
+ /// Generate call to PointerNullifyIntrinsic or AllocatableInitIntrinsic to
+ /// set the dynamic type information for a polymorphic entity from an
+ /// intrinsic type spec.
+ void genInitIntrinsic(const fir::MutableBoxValue &box,
+ const TypeCategory category, int64_t kind, int rank,
+ int corank = 0) {
+ mlir::func::FuncOp callee =
+ box.isPointer()
+ ? fir::runtime::getRuntimeFunc<mkRTKey(PointerNullifyIntrinsic)>(
+ loc, builder)
+ : fir::runtime::getRuntimeFunc<mkRTKey(AllocatableInitIntrinsic)>(
+ loc, builder);
+
+ llvm::ArrayRef<mlir::Type> inputTypes =
+ callee.getFunctionType().getInputs();
+ llvm::SmallVector<mlir::Value> args;
+ args.push_back(builder.createConvert(loc, inputTypes[0], box.getAddr()));
+ mlir::Value categoryValue = builder.createIntegerConstant(
+ loc, inputTypes[1], static_cast<int32_t>(category));
+ mlir::Value kindValue =
+ builder.createIntegerConstant(loc, inputTypes[2], kind);
+ mlir::Value rankValue =
+ builder.createIntegerConstant(loc, inputTypes[3], rank);
+ mlir::Value corankValue =
+ builder.createIntegerConstant(loc, inputTypes[4], corank);
+ args.push_back(categoryValue);
+ args.push_back(kindValue);
+ args.push_back(rankValue);
+ args.push_back(corankValue);
+ builder.create<fir::CallOp>(loc, callee, args);
+ }
+
/// Generate call to the AllocatableInitDerived to set up the type descriptor
/// and other part of the descriptor for derived type.
void genSetType(const Allocation &alloc, const fir::MutableBoxValue &box,
@@ -599,31 +673,10 @@ class AllocateStmtHelper {
// unlimited polymorphic entity.
if (typeSpec->AsIntrinsic() &&
fir::isUnlimitedPolymorphicType(fir::getBase(box).getType())) {
- mlir::func::FuncOp callee =
- box.isPointer()
- ? fir::runtime::getRuntimeFunc<mkRTKey(PointerNullifyIntrinsic)>(
- loc, builder)
- : fir::runtime::getRuntimeFunc<mkRTKey(AllocatableInitIntrinsic)>(
- loc, builder);
-
- llvm::ArrayRef<mlir::Type> inputTypes =
- callee.getFunctionType().getInputs();
- llvm::SmallVector<mlir::Value> args;
- args.push_back(builder.createConvert(loc, inputTypes[0], box.getAddr()));
- mlir::Value category = builder.createIntegerConstant(
- loc, inputTypes[1],
- static_cast<int32_t>(typeSpec->AsIntrinsic()->category()));
- mlir::Value kind = builder.createIntegerConstant(
- loc, inputTypes[2],
- Fortran::evaluate::ToInt64(typeSpec->AsIntrinsic()->kind()).value());
- mlir::Value rank = builder.createIntegerConstant(
- loc, inputTypes[3], alloc.getSymbol().Rank());
- mlir::Value corank = builder.createIntegerConstant(loc, inputTypes[4], 0);
- args.push_back(category);
- args.push_back(kind);
- args.push_back(rank);
- args.push_back(corank);
- builder.create<fir::CallOp>(loc, callee, args);
+ genInitIntrinsic(
+ box, typeSpec->AsIntrinsic()->category(),
+ Fortran::evaluate::ToInt64(typeSpec->AsIntrinsic()->kind()).value(),
+ alloc.getSymbol().Rank());
return;
}
@@ -633,24 +686,7 @@ class AllocateStmtHelper {
auto typeDescAddr = Fortran::lower::getTypeDescAddr(
builder, loc, typeSpec->derivedTypeSpec());
- mlir::func::FuncOp callee =
- box.isPointer()
- ? fir::runtime::getRuntimeFunc<mkRTKey(PointerNullifyDerived)>(
- loc, builder)
- : fir::runtime::getRuntimeFunc<mkRTKey(AllocatableInitDerived)>(
- loc, builder);
-
- llvm::ArrayRef<mlir::Type> inputTypes =
- callee.getFunctionType().getInputs();
- llvm::SmallVector<mlir::Value> args;
- args.push_back(builder.createConvert(loc, inputTypes[0], box.getAddr()));
- args.push_back(builder.createConvert(loc, inputTypes[1], typeDescAddr));
- mlir::Value rank = builder.createIntegerConstant(loc, inputTypes[2],
- alloc.getSymbol().Rank());
- mlir::Value corank = builder.createIntegerConstant(loc, inputTypes[3], 0);
- args.push_back(rank);
- args.push_back(corank);
- builder.create<fir::CallOp>(loc, callee, args);
+ genInitDerived(box, typeDescAddr, alloc.getSymbol().Rank());
}
/// Returns a pointer to the DeclTypeSpec if a type-spec is provided in the
diff --git a/flang/test/Lower/allocatable-polymorphic.f90 b/flang/test/Lower/allocatable-polymorphic.f90
index bfaf3e88d71a..d1f68f269d23 100644
--- a/flang/test/Lower/allocatable-polymorphic.f90
+++ b/flang/test/Lower/allocatable-polymorphic.f90
@@ -457,6 +457,41 @@ subroutine test_allocate_with_mold()
! CHECK: %[[UP_BOX_NONE:.*]] = fir.convert %[[UP]] : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?xnone>>>>) -> !fir.ref<!fir.box<none>>
! CHECK: %{{.*}} = fir.call @_FortranAPointerAllocate(%[[UP_BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+ subroutine test_allocate_with_source()
+ type(p2) :: x(10)
+ class(p1), pointer :: p(:)
+ integer(4) :: i(20)
+ class(*), pointer :: up(:)
+
+ allocate(p, source=x)
+ allocate(up, source=i)
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMpolyPtest_allocate_with_source() {
+! CHECK: %[[I:.*]] = fir.alloca !fir.array<20xi32> {bindc_name = "i", uniq_name = "_QMpolyFtest_allocate_with_sourceEi"}
+! CHECK: %[[P:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolyTp1{a:i32,b:i32}>>>> {bindc_name = "p", uniq_name = "_QMpolyFtest_allocate_with_sourceEp"}
+! CHECK: %[[UP:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.array<?xnone>>> {bindc_name = "up", uniq_name = "_QMpolyFtest_allocate_with_sourceEup"}
+! CHECK: %[[X:.*]] = fir.alloca !fir.array<10x!fir.type<_QMpolyTp2{a:i32,b:i32,c:i32}>> {bindc_name = "x", uniq_name = "_QMpolyFtest_allocate_with_sourceEx"}
+
+! CHECK: %[[EMBOX_X:.*]] = fir.embox %[[X]](%{{.*}}) : (!fir.ref<!fir.array<10x!fir.type<_QMpolyTp2{a:i32,b:i32,c:i32}>>>, !fir.shape<1>) -> !fir.box<!fir.array<10x!fir.type<_QMpolyTp2{a:i32,b:i32,c:i32}>>>
+! CHECK: %[[TYPE_DESC_X:.*]] = fir.box_tdesc %[[EMBOX_X]] : (!fir.box<!fir.array<10x!fir.type<_QMpolyTp2{a:i32,b:i32,c:i32}>>>) -> !fir.tdesc<none>
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[P]] : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[TYPE_DESC_NONE:.*]] = fir.convert %[[TYPE_DESC_X]] : (!fir.tdesc<none>) -> !fir.ref<none>
+! CHECK: %[[RANK:.*]] = arith.constant 1 : i32
+! CHECK: %[[CORANK:.*]] = arith.constant 0 : i32
+! CHECK: %{{.*}} = fir.call @_FortranAPointerNullifyDerived(%[[BOX_NONE]], %[[TYPE_DESC_NONE]], %[[RANK]], %[[CORANK]]) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.ref<none>, i32, i32) -> none
+! CHECK: %{{.*}} = fir.call @_FortranAPointerSetBounds
+! CHECK: %[[BOX_NONE_P:.*]] = fir.convert %[[P]] : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolyTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[BOX_NONE_X:.*]] = fir.convert %[[EMBOX_X]] : (!fir.box<!fir.array<10x!fir.type<_QMpolyTp2{a:i32,b:i32,c:i32}>>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranAPointerAllocateSource(%[[BOX_NONE_P]], %[[BOX_NONE_X]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
+! CHECK: %[[UP_BOX_NONE:.*]] = fir.convert %[[UP]] : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?xnone>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[CAT:.*]] = arith.constant 0 : i32
+! CHECK: %[[KIND:.*]] = arith.constant 4 : i32
+! CHECK: %[[RANK:.*]] = arith.constant 1 : i32
+! CHECK: %[[CORANK:.*]] = arith.constant 0 : i32
+! CHECK: %{{.*}} = fir.call @_FortranAPointerNullifyIntrinsic(%[[UP_BOX_NONE]], %[[CAT]], %[[KIND]], %[[RANK]], %[[CORANK]]) {{.*}} : (!fir.ref<!fir.box<none>>, i32, i32, i32, i32) -> none
+
end module
More information about the flang-commits
mailing list