diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 90025ba9c687a..bc9426827c3ba 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 0000000000000..866a80a3057a9 --- /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 53b257d2eacea..f53834b13de8a 100644 --- a/flang/test/Lower/allocatable-polymorphic.f90 +++ b/flang/test/Lower/allocatable-polymorphic.f90 @@ -135,12 +135,12 @@ subroutine test_pointer() ! 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 @@ subroutine test_allocatable() ! 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 0331bfb08495d..71150ef9b3414 100644 --- a/flang/test/Lower/dispatch.f90 +++ b/flang/test/Lower/dispatch.f90 @@ -182,7 +182,7 @@ subroutine check_dispatch_scalar_allocatable(p) ! 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 @@ subroutine check_dispatch_scalar_pointer(p) ! 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 fa3091d9ffa68..0f5fdd66aa53c 100644 --- a/flang/test/Lower/pointer-association-polymorphic.f90 +++ b/flang/test/Lower/pointer-association-polymorphic.f90 @@ -90,7 +90,7 @@ subroutine test_pointer() ! 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 @@ subroutine test_pointer() ! 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 @@ subroutine test_pointer() ! 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 @@ subroutine test_pointer() ! 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>>