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

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2022-11-25T21:25:09+01:00
New Revision: e6319cdcb9fad11443acbbe24b5fdaf3e910b522

URL: https://github.com/llvm/llvm-project/commit/e6319cdcb9fad11443acbbe24b5fdaf3e910b522
DIFF: https://github.com/llvm/llvm-project/commit/e6319cdcb9fad11443acbbe24b5fdaf3e910b522.diff

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

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

Reviewed By: jeanPerier

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

Added: 
    

Modified: 
    flang/lib/Lower/CallInterface.cpp
    flang/test/Lower/polymorphic.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index d26eb278069bb..4f6779e5f23da 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -115,6 +115,17 @@ Fortran::lower::CallerInterface::getPassArgIndex() const {
     }
     ++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;
 }
 

diff  --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90
index da0d6bd5eeb99..2edc1669d6939 100644
--- a/flang/test/Lower/polymorphic.f90
+++ b/flang/test/Lower/polymorphic.f90
@@ -18,6 +18,12 @@ module polymorphic_test
     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.
@@ -140,4 +146,23 @@ subroutine rebox_f32_to_none(r)
 ! 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