From e8cc230ef55923588fc6e361a2e9c868bda6025b Mon Sep 17 00:00:00 2001 From: jeanPerier Date: Wed, 11 Oct 2023 14:11:59 +0200 Subject: [PATCH] [flang] Use object before converts in fir.dispatch (#68589) In case of small interface mismatches between a function on the caller and callee side, lowering insert converts. These are very often no-ops at runtime (casting a descriptor to a descriptor), but they matter in the strongly type IR. The IR type of an object argument of a fir.dispatch must be the one of the object, not the one of the callee side dummy, which may differ in case of mismatches. Otherwise, the codgeneration of fir.dispatch cannot succeed (it will not access the right binding tables). --- flang/lib/Lower/ConvertCall.cpp | 7 +++- .../test/Lower/HLFIR/type-bound-call-mismatch.f90 | 39 ++++++++++++++++++++++ flang/test/Lower/allocatable-polymorphic.f90 | 8 ++--- flang/test/Lower/dispatch.f90 | 4 +-- .../test/Lower/pointer-association-polymorphic.f90 | 8 ++--- 5 files changed, 55 insertions(+), 11 deletions(-) create mode 100644 flang/test/Lower/HLFIR/type-bound-call-mismatch.f90 diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 90025ba9c687..bc9426827c3b 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -392,9 +392,14 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult( fir::DispatchOp dispatch; if (std::optional passArg = caller.getPassArgIndex()) { // PASS, PASS(arg-name) + // Note that caller.getInputs is used instead of operands to get the + // passed object because interface mismatch issues may have inserted a + // cast to the operand with a different declared type, which would break + // later type bound call resolution in the FIR to FIR pass. dispatch = builder.create( loc, funcType.getResults(), builder.getStringAttr(procName), - operands[*passArg], operands, builder.getI32IntegerAttr(*passArg)); + caller.getInputs()[*passArg], operands, + builder.getI32IntegerAttr(*passArg)); } else { // NOPASS const Fortran::evaluate::Component *component = diff --git a/flang/test/Lower/HLFIR/type-bound-call-mismatch.f90 b/flang/test/Lower/HLFIR/type-bound-call-mismatch.f90 new file mode 100644 index 000000000000..866a80a3057a --- /dev/null +++ b/flang/test/Lower/HLFIR/type-bound-call-mismatch.f90 @@ -0,0 +1,39 @@ +! Test interface that lowering handles small interface mismatch with +! type bound procedures. +! RUN: bbc -emit-hlfir --polymorphic-type %s -o - -I nw | FileCheck %s + +module dispatch_mismatch +type t + integer :: i +end type +type, extends(t) :: t2 + contains + procedure :: proc => foo +end type + +interface + subroutine foo(x) + import :: t2 + class(t2) :: x + end subroutine +end interface + +end module + +subroutine foo(x) + use dispatch_mismatch, only : t + ! mistmatch compared to the interface, but OK from an ABI + ! point of view, and OKI because args compatible with t2 are + ! compatible with t. + class(t) :: x +end subroutine + +subroutine test(x) + use dispatch_mismatch, only : t2 + class(t2) :: x + call x%proc() +end subroutine +!CHECK-LABEL: func.func @_QPtest( +!CHECK: %[[X:.*]]:2 = hlfir.declare %{{.*}} {uniq_name = "_QFtestEx"} +!CHECK: %[[CAST:.*]] = fir.convert %[[X]]#0 : (!fir.class>) -> !fir.class> +!CHECK: fir.dispatch "proc"(%[[X]]#0 : !fir.class>) (%[[CAST]] : !fir.class>) {pass_arg_pos = 0 : i32} diff --git a/flang/test/Lower/allocatable-polymorphic.f90 b/flang/test/Lower/allocatable-polymorphic.f90 index 53b257d2eace..f53834b13de8 100644 --- a/flang/test/Lower/allocatable-polymorphic.f90 +++ b/flang/test/Lower/allocatable-polymorphic.f90 @@ -135,12 +135,12 @@ contains ! call c1%proc2() ! CHECK: %[[C1_LOAD:.*]] = fir.load %[[C1_DESC]] : !fir.ref>>> ! CHECK: %[[C1_REBOX:.*]] = fir.rebox %[[C1_LOAD]] : (!fir.class>>) -> !fir.class> -! CHECK: fir.dispatch "proc2"(%[[C1_REBOX]] : !fir.class>) (%[[C1_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} +! CHECK: fir.dispatch "proc2"(%[[C1_LOAD]] : !fir.class>>) (%[[C1_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} ! call c2%proc2() ! CHECK: %[[C2_LOAD:.*]] = fir.load %[[C2_DESC]] : !fir.ref>>> ! CHECK: %[[C2_REBOX:.*]] = fir.rebox %[[C2_LOAD]] : (!fir.class>>) -> !fir.class> -! CHECK: fir.dispatch "proc2"(%[[C2_REBOX]] : !fir.class>) (%[[C2_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} +! CHECK: fir.dispatch "proc2"(%[[C2_LOAD]] : !fir.class>>) (%[[C2_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} ! CHECK: %[[TYPE_DESC_P1:.*]] = fir.type_desc !fir.type<_QMpolyTp1{a:i32,b:i32}> ! CHECK: %[[C3_CAST:.*]] = fir.convert %[[C3_DESC]] : (!fir.ref>>>>) -> !fir.ref> @@ -319,11 +319,11 @@ contains ! CHECK: %[[C1_LOAD2:.*]] = fir.load %[[C1_DESC]] : !fir.ref>>> ! CHECK: %[[C1_REBOX:.*]] = fir.rebox %[[C1_LOAD2]] : (!fir.class>>) -> !fir.class> -! CHECK: fir.dispatch "proc2"(%[[C1_REBOX]] : !fir.class>) (%[[C1_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} +! CHECK: fir.dispatch "proc2"(%[[C1_LOAD2]] : !fir.class>>) (%[[C1_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} ! CHECK: %[[C2_LOAD2:.*]] = fir.load %[[C2_DESC]] : !fir.ref>>> ! CHECK: %[[C2_REBOX:.*]] = fir.rebox %[[C2_LOAD2]] : (!fir.class>>) -> !fir.class> -! CHECK: fir.dispatch "proc2"(%[[C2_REBOX]] : !fir.class>) (%[[C2_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} +! CHECK: fir.dispatch "proc2"(%[[C2_LOAD2]] : !fir.class>>) (%[[C2_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} ! CHECK-LABEL: %{{.*}} = fir.do_loop ! CHECK: %[[C3_LOAD:.*]] = fir.load %[[C3_DESC]] : !fir.ref>>>> diff --git a/flang/test/Lower/dispatch.f90 b/flang/test/Lower/dispatch.f90 index 0331bfb08495..71150ef9b341 100644 --- a/flang/test/Lower/dispatch.f90 +++ b/flang/test/Lower/dispatch.f90 @@ -182,7 +182,7 @@ module call_dispatch ! CHECK-SAME: %[[ARG0:.*]]: !fir.ref>>> {fir.bindc_name = "p"}) { ! CHECK: %[[LOAD:.*]] = fir.load %[[ARG0]] : !fir.ref>>> ! CHECK: %[[REBOX:.*]] = fir.rebox %[[LOAD]] : (!fir.class>>) -> !fir.class> -! CHECK: fir.dispatch "tbp_pass"(%[[REBOX]] : !fir.class>) (%1 : !fir.class>) {pass_arg_pos = 0 : i32} +! CHECK: fir.dispatch "tbp_pass"(%[[LOAD]] : !fir.class>>) (%1 : !fir.class>) {pass_arg_pos = 0 : i32} subroutine check_dispatch_scalar_pointer(p) class(p1), pointer :: p @@ -193,7 +193,7 @@ module call_dispatch ! CHECK-SAME: %[[ARG0:.*]]: !fir.ref>>> {fir.bindc_name = "p"}) { ! CHECK: %[[LOAD:.*]] = fir.load %[[ARG0]] : !fir.ref>>> ! CHECK: %[[REBOX:.*]] = fir.rebox %[[LOAD]] : (!fir.class>>) -> !fir.class> -! CHECK: fir.dispatch "tbp_pass"(%[[REBOX]] : !fir.class>) (%1 : !fir.class>) {pass_arg_pos = 0 : i32} +! CHECK: fir.dispatch "tbp_pass"(%[[LOAD]] : !fir.class>>) (%1 : !fir.class>) {pass_arg_pos = 0 : i32} subroutine check_dispatch_static_array(p, t) class(p1) :: p(10) diff --git a/flang/test/Lower/pointer-association-polymorphic.f90 b/flang/test/Lower/pointer-association-polymorphic.f90 index fa3091d9ffa6..0f5fdd66aa53 100644 --- a/flang/test/Lower/pointer-association-polymorphic.f90 +++ b/flang/test/Lower/pointer-association-polymorphic.f90 @@ -90,7 +90,7 @@ contains ! CHECK: %{{.*}} = fir.call @_FortranAPointerAssociate(%[[P_CONV]], %[[C1_DESC_CONV]]) {{.*}} : (!fir.ref>, !fir.box) -> none ! CHECK: %[[P_DESC_LOAD:.*]] = fir.load %[[P_DESC]] : !fir.ref>>> ! CHECK: %[[P_REBOX:.*]] = fir.rebox %[[P_DESC_LOAD]] : (!fir.class>>) -> !fir.class> -! CHECK: fir.dispatch "proc"(%[[P_REBOX]] : !fir.class>) (%[[P_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} +! CHECK: fir.dispatch "proc"(%[[P_DESC_LOAD]] : !fir.class>>) (%[[P_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} ! CHECK: %[[C2_DESC_LOAD:.*]] = fir.load %[[C2_DESC]] : !fir.ref>>> ! CHECK: %[[P_CONV:.*]] = fir.convert %[[P_DESC]] : (!fir.ref>>>) -> !fir.ref> @@ -98,7 +98,7 @@ contains ! CHECK: %{{.*}} = fir.call @_FortranAPointerAssociate(%[[P_CONV]], %[[C2_DESC_CONV]]) {{.*}} : (!fir.ref>, !fir.box) -> none ! CHECK: %[[P_DESC_LOAD:.*]] = fir.load %[[P_DESC]] : !fir.ref>>> ! CHECK: %[[P_REBOX:.*]] = fir.rebox %[[P_DESC_LOAD]] : (!fir.class>>) -> !fir.class> -! CHECK: fir.dispatch "proc"(%[[P_REBOX]] : !fir.class>) (%[[P_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} +! CHECK: fir.dispatch "proc"(%[[P_DESC_LOAD]] : !fir.class>>) (%[[P_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} ! CHECK: %[[C3_LOAD:.*]] = fir.load %[[C3_DESC]] : !fir.ref>>>> ! CHECK: %[[C0:.*]] = arith.constant 0 : index @@ -113,7 +113,7 @@ contains ! CHECK: %{{.*}} = fir.call @_FortranAPointerAssociate(%[[P_CONV]], %[[C3_EMBOX_CONV]]) {{.*}} : (!fir.ref>, !fir.box) -> none ! CHECK: %[[P_DESC_LOAD:.*]] = fir.load %[[P_DESC]] : !fir.ref>>> ! CHECK: %[[P_REBOX:.*]] = fir.rebox %[[P_DESC_LOAD]] : (!fir.class>>) -> !fir.class> -! CHECK: fir.dispatch "proc"(%[[P_REBOX]] : !fir.class>) (%[[P_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} +! CHECK: fir.dispatch "proc"(%[[P_DESC_LOAD]] : !fir.class>>) (%[[P_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} ! CHECK: %[[C4_LOAD:.*]] = fir.load %[[C4_DESC]] : !fir.ref>>>> ! CHECK: %[[C0:.*]] = arith.constant 0 : index @@ -128,7 +128,7 @@ contains ! CHECK: %{{.*}} = fir.call @_FortranAPointerAssociate(%[[P_CONV]], %[[C4_EMBOX_CONV]]) {{.*}} : (!fir.ref>, !fir.box) -> none ! CHECK: %[[P_DESC_LOAD:.*]] = fir.load %[[P_DESC]] : !fir.ref>>> ! CHECK: %[[P_REBOX:.*]] = fir.rebox %[[P_DESC_LOAD]] : (!fir.class>>) -> !fir.class> -! CHECK: fir.dispatch "proc"(%[[P_REBOX]] : !fir.class>) (%[[P_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} +! CHECK: fir.dispatch "proc"(%[[P_DESC_LOAD]] : !fir.class>>) (%[[P_REBOX]] : !fir.class>) {pass_arg_pos = 0 : i32} ! CHECK: %[[C3_LOAD:.*]] = fir.load %[[C3_DESC]] : !fir.ref>>>> ! CHECK: %[[C3_REBOX:.*]] = fir.rebox %[[C3_LOAD]](%{{.*}}) : (!fir.class>>>, !fir.shift<1>) -> !fir.class>> -- 2.11.4.GIT