[flang] Lower tbp dispatch calls for polymorphic array element

[clementval]

Summary

When calling a type-bound procedure from a polymoprhic array element,
the dynamic type needs to be extracted from the array descriptor
and passed to the embox operation for the pass-object.

Depends on D135809

[clementval]

flang/lib/Optimizer/Builder/FIRBuilder.cpp

485–495

Not sure this is the best way to retrieve the array descriptor to get the tdesc. This will probably need to be rework in the future to handle other cases.

[jeanPerier]

flang/lib/Optimizer/Builder/FIRBuilder.cpp

485–495

Agreed. I think the issue here is that fir::ExtendedValue is currently not meant to deal with polymorphic scalars that are not fir.class.

We could either:

• embox such scalars right after emitting the fir.coordinate_of with te right type desc,
• extend fir.coordinate_of/array_coor to generate fir.class when the array argument is a fir.class. That may be the most robust way to deal with the situation, but it is not clear to me if we want to force the addressing to generate descriptors that may not always be needed (although LLVM should be good at getting rid of the store addr in descriptor and load it in those cases).
• or we could extent fir::ExtendedValue to carry a type descriptor for scalars otherwise tracked with only a raw address.

[clementval]

Rebase

[clementval]

flang/lib/Optimizer/Builder/FIRBuilder.cpp

485–495

Thanks for the suggestions. I'll start to work on a follow up patch to achieve a better solution here.

flang/include/flang/Optimizer/Dialect/FIROps.td

```mlir
       %52:3 = fir.box_dims %40, %c1 : (!fir.box<!fir.array<*:f64>>, i32) -> (index, index, index)
     ```
 
     The above is a request to return the left most row (at index 0) triple from
     the box. The triple will be the lower bound, extent, and byte-stride, which
     are the values encoded in a standard descriptor.
   }];
 
-  let arguments = (ins fir_BoxType:$val, AnyIntegerLike:$dim);
+  let arguments = (ins BoxOrClassType:$val, AnyIntegerLike:$dim);
 
   let results = (outs Index, Index, Index);
 
   let assemblyFormat = [{
     $val `,` $dim attr-dict `:` functional-type(operands, results)
   }];
 
   let extraClassDeclaration = [{

flang/lib/Lower/ConvertVariable.cpp

 //===--------------------------------------------------------------===//
 // Lower Variables specification expressions and attributes
 //===--------------------------------------------------------------===//
 
 /// Helper to decide if a dummy argument must be tracked in an BoxValue.
 static bool lowerToBoxValue(const Fortran::semantics::Symbol &sym,
                             mlir::Value dummyArg) {
   // Only dummy arguments coming as fir.box can be tracked in an BoxValue.
-  if (!dummyArg || !dummyArg.getType().isa<fir::BoxType>())
+  if (!dummyArg || !dummyArg.getType().isa<fir::BaseBoxType>())
     return false;
   // Non contiguous arrays must be tracked in an BoxValue.
   if (sym.Rank() > 0 && !sym.attrs().test(Fortran::semantics::Attr::CONTIGUOUS))
     return true;
   // Assumed rank and optional fir.box cannot yet be read while lowering the
   // specifications.
   if (Fortran::evaluate::IsAssumedRank(sym) ||
       Fortran::semantics::IsOptional(sym))

flang/lib/Optimizer/Builder/FIRBuilder.cpp

if (itemAddr.getType().isa<fir::BaseBoxType>())
     return itemAddr;
   auto elementType = fir::dyn_cast_ptrEleTy(itemAddr.getType());
   if (!elementType) {
     mlir::emitError(loc, "internal: expected a memory reference type ")
         << itemAddr.getType();
     llvm_unreachable("not a memory reference type");
   }
   mlir::Type boxTy = fir::BoxType::get(elementType);
-  if (isPolymorphic)
+  mlir::Value tdesc;
+  if (isPolymorphic) {
     boxTy = fir::ClassType::get(elementType);
+
+    // Look for the original tdesc for the new box.
+    if (auto *op = itemAddr.getDefiningOp()) {
+      if (auto coordOp = mlir::dyn_cast<fir::CoordinateOp>(op)) {
+        if (fir::isPolymorphicType(coordOp.getBaseType())) {
+          mlir::Type resultType = coordOp.getResult().getType();
+          mlir::Type tdescType =
+              fir::TypeDescType::get(fir::unwrapRefType(resultType));
+          tdesc = create<fir::BoxTypeDescOp>(loc, tdescType, coordOp.getRef());
+        }
+      }
+    }
+  }
+
   return exv.match(
       [&](const fir::ArrayBoxValue &box) -> mlir::Value {
         mlir::Value s = createShape(loc, exv);
         return create<fir::EmboxOp>(loc, boxTy, itemAddr, s);
       },
       [&](const fir::CharArrayBoxValue &box) -> mlir::Value {
         mlir::Value s = createShape(loc, exv);
         if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv))
return exv.match(
         return create<fir::EmboxOp>(loc, boxTy, itemAddr, emptyShape,
                                     emptySlice, lenParams);
       },
       [&](const fir::MutableBoxValue &x) -> mlir::Value {
         return create<fir::LoadOp>(
             loc, fir::factory::getMutableIRBox(*this, loc, x));
       },
       [&](const auto &) -> mlir::Value {
-        return create<fir::EmboxOp>(loc, boxTy, itemAddr);
+        mlir::Value empty;
+        mlir::ValueRange emptyRange;
+        return create<fir::EmboxOp>(loc, boxTy, itemAddr, empty, empty,
+                                    emptyRange, tdesc);
       });
 }
 
 void fir::FirOpBuilder::dumpFunc() { getFunction().dump(); }
 
 static mlir::Value
 genNullPointerComparison(fir::FirOpBuilder &builder, mlir::Location loc,
                          mlir::Value addr,

flang/test/Lower/dispatch.f90

contains
     procedure :: proc2 => p1_proc2
     procedure, pass(this) :: proc3 => p1_proc3_arg0
     procedure, pass(this) :: proc4 => p1_proc4_arg1
 
     procedure, nopass :: p1_fct1_nopass
     procedure :: p1_fct2
     procedure, pass(this) :: p1_fct3_arg0
     procedure, pass(this) :: p1_fct4_arg1
+
+    procedure :: pass_with_class_arg
   end type
 
   type, abstract :: a1
     real :: a
     real :: b
   contains
     procedure(nopass_defferred), deferred, nopass :: nopassd
   end type
! ------------------------------------------------------------------------------
 
     function p1_fct4_arg1(i, this)
       real :: p1_fct2
       integer :: i
       class(p1) :: this
     end function
     ! CHECK-LABEL: func.func @_QMcall_dispatchPp1_fct4_arg1(%{{.*}}: !fir.ref<i32>, %{{.*}}: !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) -> f32
 
+    subroutine pass_with_class_arg(this, other)
+      class(p1) :: this
+      class(p1) :: other
+    end subroutine
+    ! CHECK-LABEL: func.func @_QMcall_dispatchPpass_with_class_arg(%{{.*}}: !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>, %{{.*}}: !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) {
+
     subroutine p1_proc1_nopass()
     end subroutine
     ! CHECK-LABEL: func.func @_QMcall_dispatchPp1_proc1_nopass()
 
     subroutine p1_proc2(p)
       class(p1) :: p
     end subroutine
     ! CHECK-LABEL: func.func @_QMcall_dispatchPp1_proc2(%{{.*}}: !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>)
! CHECK: fir.dispatch "tbp_pass"(%[[REBOX]] : !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) (%1 : !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) {pass_arg_pos = 0 : i32}
     end subroutine
 
 ! CHECK-LABEL: func.func @_QMcall_dispatchPcheck_dispatch_scalar_pointer(
 ! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>> {fir.bindc_name = "p"}) {
 ! CHECK: %[[LOAD:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>
 ! CHECK: %[[REBOX:.*]] = fir.rebox %[[LOAD]] : (!fir.class<!fir.ptr<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>) -> !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
 ! CHECK: fir.dispatch "tbp_pass"(%[[REBOX]] : !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) (%1 : !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) {pass_arg_pos = 0 : i32}
 
+    subroutine check_dispatch_static_array(p, t)
+      class(p1) :: p(10)
+      type(p1) :: t(10)
+      integer :: i
+      do i = 1, 10
+        call p(i)%tbp_pass()
+      end do
+
+      do i = 1, 10
+        call t(i)%tbp_pass()
+      end do
+    end subroutine
+
+! CHECK-LABEL: func.func @_QMcall_dispatchPcheck_dispatch_static_array(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.array<10x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>> {fir.bindc_name = "p"}, 
+! CHECK-SAME: %[[ARG1:.*]]: !fir.ref<!fir.array<10x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>> {fir.bindc_name = "t"}) {
+! CHECK: fir.do_loop {{.*}} {
+! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[ARG0]], %{{.*}} : (!fir.class<!fir.array<10x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>, i64) -> !fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[TDESC:.*]] = fir.box_tdesc %[[ARG0]] : (!fir.class<!fir.array<10x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>) -> !fir.tdesc<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[CLASS_BOX:.*]] = fir.embox %[[COORD]] tdesc %[[TDESC]] : (!fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>, !fir.tdesc<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: fir.dispatch "tbp_pass"(%[[CLASS_BOX]] : !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) (%[[CLASS_BOX]] : !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) {pass_arg_pos = 0 : i32}
+
+! CHECK: fir.do_loop {{.*}} {
+! CHECK: %[[COORD1:.*]] = fir.coordinate_of %[[ARG1]], %{{.*}} : (!fir.ref<!fir.array<10x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>, i64) -> !fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[EMBOX:.*]] = fir.embox %[[COORD]] : (!fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: fir.call @_QMcall_dispatchPtbp_pass(%[[EMBOX]]) : (!fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) -> ()
+
+    subroutine check_dispatch_dynamic_array(p, t)
+      class(p1) :: p(:)
+      type(p1) :: t(:)
+      integer :: i
+      do i = 1, 10
+        call p(i)%tbp_pass()
+      end do
+
+      do i = 1, 10
+        call t(i)%tbp_pass()
+      end do
+    end subroutine
+
+! CHECK-LABEL: func.func @_QMcall_dispatchPcheck_dispatch_dynamic_array(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>> {fir.bindc_name = "p"}, 
+! CHECK-SAME: %[[ARG1:.*]]: !fir.box<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>> {fir.bindc_name = "t"}) {
+! CHECK: %{{.*}} = fir.do_loop {{.*}} {
+! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[ARG0]], %{{.*}} : (!fir.class<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>, i64) -> !fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[TDESC:.*]] = fir.box_tdesc %[[ARG0]] : (!fir.class<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>) -> !fir.tdesc<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[CLASS_BOX:.*]] = fir.embox %[[COORD]] tdesc %[[TDESC]] : (!fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>, !fir.tdesc<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: fir.dispatch "tbp_pass"(%[[CLASS_BOX]] : !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) (%[[CLASS_BOX]] : !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) {pass_arg_pos = 0 : i32}
+
+! CHECK: %{{.*}} = fir.do_loop {{.*}} {
+! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[ARG1]], %{{.*}} : (!fir.box<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>, i64) -> !fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[EMBOX:.*]] = fir.embox %[[COORD]] : (!fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: fir.call @_QMcall_dispatchPtbp_pass(%[[EMBOX]]) : (!fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) -> ()
+
+    subroutine check_dispatch_allocatable_array(p, t)
+      class(p1), allocatable :: p(:)
+      type(p1), allocatable :: t(:)
+      integer :: i
+      do i = 1, 10
+        call p(i)%tbp_pass()
+      end do
+
+      do i = 1, 10
+        call t(i)%tbp_pass()
+      end do
+    end subroutine
+
+! CHECK-LABEL: func.func @_QMcall_dispatchPcheck_dispatch_allocatable_array(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>> {fir.bindc_name = "p"}, 
+! CHECK-SAME: %[[ARG1:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>> {fir.bindc_name = "t"}) {
+! CHECK: %{{.*}} = fir.do_loop {{.*}} {
+! CHECK: fir.store %arg3 to %0 : !fir.ref<i32>
+! CHECK: %[[LOAD_ARG0:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>>
+! CHECK: %[[C0:.*]] = arith.constant 0 : index
+! CHECK: %[[BOX_DIMS_ARG0:.*]]:3 = fir.box_dims %[[LOAD_ARG0]], %[[C0]] : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>, index) -> (index, index, index)
+! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[LOAD_ARG0]], %{{.*}} : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>, i64) -> !fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[TDESC_ARG0:.*]] = fir.box_tdesc %[[LOAD_ARG0]] : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>) -> !fir.tdesc<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[CLASS_BOX:.*]] = fir.embox %[[COORD]] tdesc %[[TDESC_ARG0]] : (!fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>, !fir.tdesc<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: fir.dispatch "tbp_pass"(%[[CLASS_BOX]] : !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) (%[[CLASS_BOX]] : !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) {pass_arg_pos = 0 : i32}
+
+! CHECK: %{{.*}} = fir.do_loop {{.*}} {
+! CHECK: %[[LOAD_ARG1:.*]] = fir.load %[[ARG1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>>
+! CHECK: %[[C0:.*]] = arith.constant 0 : index
+! CHECK: %[[BOX_DIMS_ARG1:.*]]:3 = fir.box_dims %[[LOAD_ARG1]], %[[C0]] : (!fir.box<!fir.heap<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>, index) -> (index, index, index)
+! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[LOAD_ARG1]], %{{.*}} : (!fir.box<!fir.heap<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>, i64) -> !fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[EMBOX:.*]] = fir.embox %[[COORD]] : (!fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: fir.call @_QMcall_dispatchPtbp_pass(%[[EMBOX]]) : (!fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) -> ()
+
+    subroutine check_dispatch_pointer_array(p, t)
+      class(p1), pointer :: p(:)
+      type(p1), pointer :: t(:)
+      integer :: i
+      do i = 1, 10
+        call p(i)%tbp_pass()
+      end do
+
+      do i = 1, 10
+        call t(i)%tbp_pass()
+      end do
+    end subroutine
+
+! CHECK-LABEL: func.func @_QMcall_dispatchPcheck_dispatch_pointer_array(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>> {fir.bindc_name = "p"}, 
+! CHECK-SAME: %[[ARG1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>> {fir.bindc_name = "t"}) {
+
+! CHECK: %{{.*}} = fir.do_loop {{.*}} {
+! CHECK: %[[LOAD_ARG0:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>>
+! CHECK: %[[C0:.*]] = arith.constant 0 : index
+! CHECK: %[[BOX_DIMS_ARG0]]:3 = fir.box_dims %[[LOAD_ARG0]], %[[C0]] : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>, index) -> (index, index, index)
+! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[LOAD_ARG0]], %{{.*}} : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>, i64) -> !fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[TDESC_ARG0:.*]] = fir.box_tdesc %[[LOAD_ARG0]] : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>) -> !fir.tdesc<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[CLASS_BOX]] = fir.embox %[[COORD]] tdesc %[[TDESC_ARG0]] : (!fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>, !fir.tdesc<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: fir.dispatch "tbp_pass"(%[[CLASS_BOX]] : !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) (%[[CLASS_BOX]] : !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) {pass_arg_pos = 0 : i32}
+
+! CHECK: %{{.*}} = fir.do_loop {{.*}} {
+! CHECK: %[[LOAD_ARG1:.*]] = fir.load %[[ARG1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>>
+! CHECK: %[[C0:.*]] = arith.constant 0 : index
+! CHECK: %[[BOX_DIMS_ARG1:.*]]:3 = fir.box_dims %[[LOAD_ARG1]], %[[C0]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>, index) -> (index, index, index)
+! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[LOAD_ARG1]], %{{.*}} : (!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>>, i64) -> !fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[EMBOX:.*]] = fir.embox %[[COORD]] : (!fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: fir.call @_QMcall_dispatchPtbp_pass(%[[EMBOX]]) : (!fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) -> ()
+
+    subroutine check_dispatch_dynamic_array_copy(p, o)
+      class(p1) :: p(:)
+      class(p1) :: o(:)
+
+      integer :: i
+      do i = 1, 9
+        call p(i)%pass_with_class_arg(o(i+1))
+      end do
+    end subroutine
+
+! CHECK-LABEL: func.func @_QMcall_dispatchPcheck_dispatch_dynamic_array_copy(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>> {fir.bindc_name = "p"}, 
+! CHECK-SAME: %[[ARG1:.*]]: !fir.class<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>> {fir.bindc_name = "o"}) {
+! CHECK: %{{.*}} = fir.do_loop {{.*}} {
+! CHECK: %[[COORD1:.*]] = fir.coordinate_of %[[ARG0]], %{{.*}} : (!fir.class<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>, i64) -> !fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[TDESC1:.*]] = fir.box_tdesc %[[ARG0]] : (!fir.class<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>) -> !fir.tdesc<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[CLASS1:.*]] = fir.embox %[[COORD1]] tdesc %[[TDESC1]] : (!fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>, !fir.tdesc<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[COORD2:.*]] = fir.coordinate_of %[[ARG1]], %{{.*}} : (!fir.class<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>, i64) -> !fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[TDESC2:.*]] = fir.box_tdesc %[[ARG1]] : (!fir.class<!fir.array<?x!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>>) -> !fir.tdesc<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: %[[CLASS2:.*]] = fir.embox %[[COORD2]] tdesc %[[TDESC2]] : (!fir.ref<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>, !fir.tdesc<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>
+! CHECK: fir.dispatch "pass_with_class_arg"(%[[CLASS1]] : !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) (%[[CLASS1]], %[[CLASS2]] : !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>, !fir.class<!fir.type<_QMcall_dispatchTp1{a:i32,b:i32}>>) {pass_arg_pos = 0 : i32}
+
 ! ------------------------------------------------------------------------------
 ! Test that direct call is emitted when the type is known
 ! ------------------------------------------------------------------------------
 
     subroutine check_nodispatch(t)
       type(p1) :: t
       call t%tbp_nopass()
       call t%tbp_pass()