From 69bbcdd0aba9bbfad8957860e24a792b85017146 Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval@gmail.com>
Date: Tue, 10 Jan 2023 20:57:39 +0100
Subject: [PATCH] [flang] Load unlimited polymorphic box the same way as other

Unlimited polymorphic descriptor have a set size and can be loaded the
same way as polymorphic or monomorphic descriptors. The descriptor
code gen as been set in D138587.
Of course, the data hold by those descriptors have an unknown size
at compile time.

Depends on D141383

Reviewed By: jeanPerier, PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D141390
---
 flang/lib/Optimizer/CodeGen/CodeGen.cpp |  7 +++----
 flang/test/Fir/polymorphic.fir          | 23 +++++++++++++++++++++++
 2 files changed, 26 insertions(+), 4 deletions(-)

diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp
index 16af6e0..84b5765 100644
--- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp
+++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp
@@ -3013,12 +3013,11 @@ struct LoadOpConversion : public FIROpConversion<fir::LoadOp> {
       auto inputBoxStorage = adaptor.getOperands()[0];
       mlir::Location loc = load.getLoc();
       fir::SequenceType seqTy = fir::unwrapUntilSeqType(boxTy);
-      mlir::Type eleTy = fir::unwrapPassByRefType(boxTy);
-      // fir.box of assumed rank and polymorphic entities do not have a storage
+      // fir.box of assumed rank do not have a storage
       // size that is know at compile time. The copy needs to be runtime driven
       // depending on the actual dynamic rank or type.
-      if (eleTy.isa<mlir::NoneType>() || (seqTy && seqTy.hasUnknownShape()))
-        TODO(loc, "loading polymorphic or assumed rank fir.box");
+      if (seqTy && seqTy.hasUnknownShape())
+        TODO(loc, "loading or assumed rank fir.box");
       mlir::Type boxPtrTy = inputBoxStorage.getType();
       auto boxValue = rewriter.create<mlir::LLVM::LoadOp>(
           loc, boxPtrTy.cast<mlir::LLVM::LLVMPointerType>().getElementType(),
diff --git a/flang/test/Fir/polymorphic.fir b/flang/test/Fir/polymorphic.fir
index 58b1982..a246521 100644
--- a/flang/test/Fir/polymorphic.fir
+++ b/flang/test/Fir/polymorphic.fir
@@ -159,4 +159,27 @@ func.func @_QQmain() {
 // CHECK: store { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %[[LOAD]], ptr %[[DESC]]
 // CHECK: call void @_QMmod1Psub1(ptr %[[DESC]])
 
+fir.global @_QMmod2Ep : !fir.class<!fir.ptr<none>> {
+  %0 = fir.zero_bits !fir.ptr<none>
+  %1 = fir.embox %0 : (!fir.ptr<none>) -> !fir.class<!fir.ptr<none>>
+  fir.has_value %1 : !fir.class<!fir.ptr<none>>
+}
+func.func @_QMmod2Pinitp(%arg0: !fir.ref<!fir.class<!fir.ptr<none>>> {fir.bindc_name = "target"}) {
+  %0 = fir.address_of(@_QMmod2Ep) : !fir.ref<!fir.class<!fir.ptr<none>>>
+  %1 = fir.load %arg0 : !fir.ref<!fir.class<!fir.ptr<none>>>
+  %2 = fir.convert %0 : (!fir.ref<!fir.class<!fir.ptr<none>>>) -> !fir.ref<!fir.box<none>>
+  %3 = fir.convert %1 : (!fir.class<!fir.ptr<none>>) -> !fir.box<none>
+  %4 = fir.call @_FortranAPointerAssociate(%2, %3) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.box<none>) -> none
+  return
+}
+func.func private @_FortranAPointerAssociate(!fir.ref<!fir.box<none>>, !fir.box<none>) -> none attributes {fir.runtime}
+
+// CHECK-LABEL: define void @_QMmod2Pinitp(
+// CHECK-SAME: ptr %[[ARG0:.*]]) {
+// CHECK: %[[ALLOCA_CLASS_NONE:.*]] = alloca { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }
+// CHECK: %[[LOAD:.*]] = load { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }, ptr %[[ARG0]]
+// CHECK: store { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %[[LOAD]], ptr %[[ALLOCA_CLASS_NONE]]
+// CHECK: %{{.*}} = call {} @_FortranAPointerAssociate(ptr @_QMmod2Ep, ptr %[[ALLOCA_CLASS_NONE]])
+// CHECK: ret void
+
 
-- 
2.7.4