[flang] Handle dispatch on nopass procedure from array element

When a fir.dispatch is done with a NOPASS type-bound
procedure, the object in fir.dispatch is just used to gather the vtable.
Therefore, no transformation is done on it and the original entity
is used. The current code generation didn't expect the entity to be an array.
This patch update the code generation to be able to retrieve the vtable
accordingly.

Reviewed By: PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D137255

diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp
index fae601b..be49a0b 100644 (file)
--- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp
+++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp
@@ -915,12 +915,17 @@ struct DispatchOpConversion : public FIROpConversion<fir::DispatchOp> {
       return emitError(loc) << "no binding tables found";
 
     // Get derived type information.
-    auto declaredType = llvm::TypeSwitch<mlir::Type, mlir::Type>(
-                            dispatch.getObject().getType().getEleTy())
-                            .Case<fir::PointerType, fir::HeapType>(
-                                [](auto p) { return p.getEleTy(); })
-                            .Default([](mlir::Type t) { return t; });
-
+    auto declaredType =
+        llvm::TypeSwitch<mlir::Type, mlir::Type>(
+            dispatch.getObject().getType().getEleTy())
+            .Case<fir::PointerType, fir::HeapType, fir::SequenceType>(
+                [](auto p) {
+                  if (auto seq =
+                          p.getEleTy().template dyn_cast<fir::SequenceType>())
+                    return seq.getEleTy();
+                  return p.getEleTy();
+                })
+            .Default([](mlir::Type t) { return t; });
     assert(declaredType.isa<fir::RecordType>() && "expecting fir.type");
     auto recordType = declaredType.dyn_cast<fir::RecordType>();
     std::string typeDescName =

diff --git a/flang/test/Fir/dispatch.f90 b/flang/test/Fir/dispatch.f90
index e3e75f2..7b462df 100644 (file)
--- a/flang/test/Fir/dispatch.f90
+++ b/flang/test/Fir/dispatch.f90
@@ -120,6 +120,21 @@ contains
     call p%proc_pass(1)
   end subroutine
 
+  subroutine no_pass_array(a)
+    class(p1) :: a(:)
+    call a(1)%proc_nopass()
+  end subroutine
+
+  subroutine no_pass_array_allocatable(a)
+    class(p1), allocatable :: a(:)
+    call a(1)%proc_nopass()
+  end subroutine
+
+  subroutine no_pass_array_pointer(a)
+    class(p1), allocatable :: a(:)
+    call a(1)%proc_nopass()
+  end subroutine
+
 end module
 
 program test_type_to_class
@@ -232,6 +247,9 @@ end
 ! CHECK: %[[FUNC_PTR:.*]] = inttoptr i64 %[[FUNC_ADDR]] to ptr
 ! CHECK: call void %[[FUNC_PTR]](ptr %[[INT32]], ptr %[[CLASS]])
 
+! CHECK-LABEL: _QMdispatch1Pno_pass_array
+! CHECK-LABEL: _QMdispatch1Pno_pass_array_allocatable
+! CHECK-LABEL: _QMdispatch1Pno_pass_array_pointer
 
 ! Check the layout of the binding table. This is easier to do in FIR than in 
 ! LLVM IR.