[flang] Update fir.dispatch op lowering for tbp with character result

[clementval]

Summary

Take into account the result passed as arguments when computing
the pass object index.

[clementval]

Return if not passArg

[jeanPerier]

Looks good

flang/lib/Lower/CallInterface.cpp

Fortran::lower::CallerInterface::getPassArgIndex() const {
   std::optional<unsigned> passArg = std::nullopt;
   for (const auto &arg : getCallDescription().arguments()) {
     if (arg && arg->isPassedObject()) {
       passArg = passArgIdx;
       break;
     }
     ++passArgIdx;
   }
+  if (!passArg)
+    return passArg;
+  // Take into account result inserted as arguments.
+  if (std::optional<Fortran::lower::CallInterface<
+          Fortran::lower::CallerInterface>::PassedEntity>
+          resultArg = getPassedResult()) {
+    if (resultArg->passBy == PassEntityBy::AddressAndLength)
+      passArg = *passArg + 2;
+    else if (resultArg->passBy == PassEntityBy::BaseAddress)
+      passArg = *passArg + 1;
+  }
   return passArg;
 }
 
 const Fortran::semantics::Symbol *
 Fortran::lower::CallerInterface::getIfIndirectCallSymbol() const {
   if (const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol())
     if (Fortran::semantics::IsPointer(*symbol) ||
         Fortran::semantics::IsDummy(*symbol))

flang/test/Lower/polymorphic.f90

module polymorphic_test
   type, extends(p1) :: p2
     real :: c
   end type
 
   type r1
     real, pointer :: rp(:) => null()
   end type
 
+  type c1
+    character(2) :: tmp = 'c1'
+  contains
+    procedure :: get_tmp
+  end type
+
   contains
 
   ! Test correct access to polymorphic entity component.
   subroutine component_access(p)
     class(p1) :: p
     print*, p%a
   end subroutine
 

 ! CHECK: %[[C0:.*]] = arith.constant 0 : index
 ! CHECK: %[[RP_DIMS:.*]]:3 = fir.box_dims %[[LOADED_RP]], %[[C0]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
 ! CHECK: %[[SHIFT:.*]] = fir.shift %[[RP_DIMS]]#0 : (index) -> !fir.shift<1>
 ! CHECK: %[[REBOX_TO_BOX:.*]] = fir.rebox %[[LOADED_RP]](%[[SHIFT]]) : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.shift<1>) -> !fir.box<!fir.array<?xf32>>
 ! CHECK: %[[REBOX_TO_UP:.*]] = fir.rebox %[[REBOX_TO_BOX]] : (!fir.box<!fir.array<?xf32>>) -> !fir.class<!fir.ptr<!fir.array<?xnone>>>
 ! CHECK: fir.store %[[REBOX_TO_UP]] to %[[P]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?xnone>>>>
 ! CHECK: return
 
+! Test that the fir.dispatch operation is created with the correct pass object
+! and the pass_arg_pos attribute is incremented correctly when character
+! function result is added as argument.
+
+  function get_tmp(this)
+    class(c1) :: this
+    character(2) :: get_tmp
+    get_tmp = this%tmp
+  end function
+
+  subroutine call_get_tmp(c)
+    class(c1) :: c
+    print*, c%get_tmp()
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPcall_get_tmp(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTc1{tmp:!fir.char<1,2>}>> {fir.bindc_name = "c"}) {
+! CHECK: %{{.*}} = fir.dispatch "get_tmp"(%[[ARG0]] : !fir.class<!fir.type<_QMpolymorphic_testTc1{tmp:!fir.char<1,2>}>>) (%{{.*}}, %{{.*}}, %[[ARG0]] : !fir.ref<!fir.char<1,2>>, index, !fir.class<!fir.type<_QMpolymorphic_testTc1{tmp:!fir.char<1,2>}>>) -> !fir.boxchar<1> {pass_arg_pos = 2 : i32}
+
 end module