[flang-commits] [flang] 94d89aa - [flang] Allocate polymorphic with SOURCE= using ApplyMold
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Wed Jan 18 09:52:12 PST 2023
Author: Valentin Clement
Date: 2023-01-18T18:52:04+01:00
New Revision: 94d89aaaa2effd2a8047664e023366d6c36c35d5
URL: https://github.com/llvm/llvm-project/commit/94d89aaaa2effd2a8047664e023366d6c36c35d5
DIFF: https://github.com/llvm/llvm-project/commit/94d89aaaa2effd2a8047664e023366d6c36c35d5.diff
LOG: [flang] Allocate polymorphic with SOURCE= using ApplyMold
Source allocation is similar to mold allocation + assignment. Use
ApplyMold runtime entry point for polymorphic source allocation.
It could be generalized for other source allocation.
Reviewed By: jeanPerier, PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D141996
Added:
Modified:
flang/lib/Lower/Allocatable.cpp
flang/test/Lower/allocatable-polymorphic.f90
flang/unittests/Runtime/Pointer.cpp
Removed:
################################################################################
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index b774c962bf27c..c5320421f8120 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -565,25 +565,8 @@ class AllocateStmtHelper {
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());
- }
- }
+ if (alloc.type.IsPolymorphic())
+ genRuntimeAllocateApplyMold(builder, loc, box, sourceExv);
genSetDeferredLengthParameters(alloc, box);
genAllocateObjectBounds(alloc, box);
mlir::Value stat =
diff --git a/flang/test/Lower/allocatable-polymorphic.f90 b/flang/test/Lower/allocatable-polymorphic.f90
index d1f68f269d23e..43b7151953cd9 100644
--- a/flang/test/Lower/allocatable-polymorphic.f90
+++ b/flang/test/Lower/allocatable-polymorphic.f90
@@ -472,25 +472,38 @@ subroutine test_allocate_with_source()
! 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: %[[P_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: %[[X_BOX_NONE:.*]] = fir.convert %[[EMBOX_X]] : (!fir.box<!fir.array<10x!fir.type<_QMpolyTp2{a:i32,b:i32,c:i32}>>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranAPointerApplyMold(%[[P_BOX_NONE]], %[[X_BOX_NONE]]) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>) -> 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: %[[EMBOX_I:.*]] = fir.embox %[[I]](%{{.*}}) : (!fir.ref<!fir.array<20xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<20xi32>>
! 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
+! CHECK: %[[I_BOX_NONE:.*]] = fir.convert %[[EMBOX_I]] : (!fir.box<!fir.array<20xi32>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranAPointerApplyMold(%[[UP_BOX_NONE]], %[[I_BOX_NONE]]) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>) -> none
+! CHECK: %{{.*}} = fir.call @_FortranAPointerSetBounds
+! CHECK: %[[UP_BOX_NONE:.*]] = fir.convert %[[UP]] : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?xnone>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[I_BOX_NONE:.*]] = fir.convert %[[EMBOX_I]] : (!fir.box<!fir.array<20xi32>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranAPointerAllocateSource(%[[UP_BOX_NONE]], %[[I_BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
+ subroutine test_allocatable_up_from_up_mold(a, b)
+ class(*), allocatable :: a
+ class(*), pointer :: b
+ allocate(a, source = b)
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMpolyPtest_allocatable_up_from_up_mold(
+! CHECK-SAME: %[[A:.*]]: !fir.ref<!fir.class<!fir.heap<none>>> {fir.bindc_name = "a"}, %[[B:.*]]: !fir.ref<!fir.class<!fir.ptr<none>>> {fir.bindc_name = "b"}) {
+! CHECK: %[[LOAD_B:.*]] = fir.load %[[B]] : !fir.ref<!fir.class<!fir.ptr<none>>>
+! CHECK: %[[A_BOX_NONE:.*]] = fir.convert %[[A]] : (!fir.ref<!fir.class<!fir.heap<none>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[B_BOX_NONE:.*]] = fir.convert %[[LOAD_B]] : (!fir.class<!fir.ptr<none>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableApplyMold(%[[A_BOX_NONE]], %[[B_BOX_NONE]]) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>) -> none
+! CHECK: %[[A_BOX_NONE:.*]] = fir.convert %[[A]] : (!fir.ref<!fir.class<!fir.heap<none>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[B_BOX_NONE:.*]] = fir.convert %[[LOAD_B]] : (!fir.class<!fir.ptr<none>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocateSource(%[[A_BOX_NONE]], %[[B_BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
end module
diff --git a/flang/unittests/Runtime/Pointer.cpp b/flang/unittests/Runtime/Pointer.cpp
index 72393f36aa9ad..caf7d7e986520 100644
--- a/flang/unittests/Runtime/Pointer.cpp
+++ b/flang/unittests/Runtime/Pointer.cpp
@@ -30,3 +30,24 @@ TEST(Pointer, BasicAllocateDeallocate) {
(*p, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
EXPECT_FALSE(RTNAME(PointerIsAssociated)(*p));
}
+
+TEST(Pointer, ApplyMoldAllocation) {
+ // REAL(4), POINTER :: p
+ auto m{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4,
+ nullptr, 0, nullptr, CFI_attribute_pointer)};
+ RTNAME(PointerAllocate)
+ (*m, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
+
+ // CLASS(*), POINTER :: p
+ auto p{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4,
+ nullptr, 0, nullptr, CFI_attribute_pointer)};
+ p->raw().elem_len = 0;
+ p->raw().type = CFI_type_other;
+
+ RTNAME(PointerApplyMold)(*p, *m);
+ RTNAME(PointerAllocate)
+ (*p, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
+
+ EXPECT_EQ(p->ElementBytes(), m->ElementBytes());
+ EXPECT_EQ(p->type(), m->type());
+}
More information about the flang-commits
mailing list