1! RUN: bbc -emit-hlfir %s -o - | fir-opt --fir-polymorphic-op | FileCheck %s 2! RUN: bbc -emit-hlfir %s -o - | FileCheck %s --check-prefix=BT 3 4! Tests codegen of fir.dispatch operation. This test is intentionally run from 5! Fortran through bbc and tco so we have all the binding tables lowered to FIR 6! from semantics. 7 8module dispatch1 9 10 type p1 11 integer :: a 12 integer :: b 13 contains 14 procedure :: aproc 15 procedure :: display1 => display1_p1 16 procedure :: display2 => display2_p1 17 procedure :: get_value => get_value_p1 18 procedure :: proc_with_values => proc_p1 19 procedure, nopass :: proc_nopass => proc_nopass_p1 20 procedure, pass(this) :: proc_pass => proc_pass_p1 21 procedure, nopass :: z_proc_nopass_bindc => proc_nopass_bindc_p1 22 end type 23 24 type, extends(p1) :: p2 25 integer :: c 26 contains 27 procedure :: display1 => display1_p2 28 procedure :: display2 => display2_p2 29 procedure :: display3 30 procedure :: get_value => get_value_p2 31 procedure :: proc_with_values => proc_p2 32 procedure, nopass :: proc_nopass => proc_nopass_p2 33 procedure, pass(this) :: proc_pass => proc_pass_p2 34 procedure, nopass :: z_proc_nopass_bindc => proc_nopass_bindc_p2 35 end type 36 37 type, abstract :: a1 38 integer a 39 contains 40 procedure :: a1_proc 41 end type 42 43 type, extends(a1) :: a2 44 integer b 45 contains 46 procedure :: a1_proc => a2_proc 47 end type 48 49 type ty_kind(i, j) 50 integer, kind :: i, j 51 integer :: a(i) 52 end Type 53 54 type, extends(ty_kind) :: ty_kind_ex 55 integer :: b(j) 56 end type 57 type(ty_kind(10,20)) :: tk1 58 type(ty_kind_ex(10,20)) :: tke1 59contains 60 61 subroutine display1_p1(this) 62 class(p1) :: this 63 print*,'call display1_p1' 64 end subroutine 65 66 subroutine display2_p1(this) 67 class(p1) :: this 68 print*,'call display2_p1' 69 end subroutine 70 71 subroutine display1_p2(this) 72 class(p2) :: this 73 print*,'call display1_p2' 74 end subroutine 75 76 subroutine display2_p2(this) 77 class(p2) :: this 78 print*,'call display2_p2' 79 end subroutine 80 81 subroutine aproc(this) 82 class(p1) :: this 83 print*,'call aproc' 84 end subroutine 85 86 subroutine display3(this) 87 class(p2) :: this 88 print*,'call display3' 89 end subroutine 90 91 function get_value_p1(this) 92 class(p1) :: this 93 integer :: get_value_p1 94 get_value_p1 = 10 95 end function 96 97 function get_value_p2(this) 98 class(p2) :: this 99 integer :: get_value_p2 100 get_value_p2 = 10 101 end function 102 103 subroutine proc_p1(this, v) 104 class(p1) :: this 105 real :: v 106 print*, 'call proc1 with ', v 107 end subroutine 108 109 subroutine proc_p2(this, v) 110 class(p2) :: this 111 real :: v 112 print*, 'call proc1 with ', v 113 end subroutine 114 115 subroutine proc_nopass_p1() 116 print*, 'call proc_nopass_p1' 117 end subroutine 118 119 subroutine proc_nopass_p2() 120 print*, 'call proc_nopass_p2' 121 end subroutine 122 123 subroutine proc_nopass_bindc_p1() bind(c) 124 print*, 'call proc_nopass_bindc_p1' 125 end subroutine 126 127 subroutine proc_nopass_bindc_p2() bind(c) 128 print*, 'call proc_nopass_bindc_p2' 129 end subroutine 130 131 subroutine proc_pass_p1(i, this) 132 integer :: i 133 class(p1) :: this 134 print*, 'call proc_pass_p1' 135 end subroutine 136 137 subroutine proc_pass_p2(i, this) 138 integer :: i 139 class(p2) :: this 140 print*, 'call proc_pass_p2' 141 end subroutine 142 143 subroutine display_class(p) 144 class(p1) :: p 145 integer :: i 146 call p%display2() 147 call p%display1() 148 call p%aproc() 149 i = p%get_value() 150 call p%proc_with_values(2.5) 151 call p%proc_nopass() 152 call p%proc_pass(1) 153 call p%z_proc_nopass_bindc() 154 end subroutine 155 156 subroutine no_pass_array(a) 157 class(p1) :: a(:) 158 call a(1)%proc_nopass() 159 end subroutine 160 161 subroutine no_pass_array_allocatable(a) 162 class(p1), allocatable :: a(:) 163 call a(1)%proc_nopass() 164 end subroutine 165 166 subroutine no_pass_array_pointer(a) 167 class(p1), allocatable :: a(:) 168 call a(1)%proc_nopass() 169 end subroutine 170 171 subroutine a1_proc(this) 172 class(a1) :: this 173 end subroutine 174 175 subroutine a2_proc(this) 176 class(a2) :: this 177 end subroutine 178 179 subroutine call_a1_proc(p) 180 class(a1), pointer :: p 181 call p%a1_proc() 182 end subroutine 183 184end module 185 186program test_type_to_class 187 use dispatch1 188 type(p1) :: t1 = p1(1,2) 189 type(p2) :: t2 = p2(1,2,3) 190 191 call display_class(t1) 192 call display_class(t2) 193end 194 195 196! CHECK-LABEL: func.func @_QMdispatch1Pdisplay_class( 197! CHECK-SAME: %[[ARG:.*]]: [[CLASS:!fir.class<.*>>]] 198! CHECK: %[[ARG_DECL:.*]]:2 = hlfir.declare %[[ARG]] dummy_scope %{{[0-9]+}} {uniq_name = "_QMdispatch1Fdisplay_classEp"} : (!fir.class<!fir.type<_QMdispatch1Tp1{a:i32,b:i32}>>, !fir.dscope) -> (!fir.class<!fir.type<_QMdispatch1Tp1{a:i32,b:i32}>>, !fir.class<!fir.type<_QMdispatch1Tp1{a:i32,b:i32}>>) 199 200! Check dynamic dispatch equal to `call p%display2()` with binding index = 2. 201! CHECK: %[[BOXDESC:.*]] = fir.box_tdesc %[[ARG_DECL]]#0 : ([[CLASS]]) -> !fir.tdesc<none> 202! CHECK: %[[TYPEDESCPTR:.*]] = fir.convert %[[BOXDESC]] : (!fir.tdesc<none>) -> !fir.ref<[[TYPEINFO:!fir.type<_QM__fortran_type_infoTderivedtype{.*}>]]> 203! CHECK: %[[BINDING_FIELD:.*]] = fir.field_index binding, [[TYPEINFO]] 204! CHECK: %[[BINDING_BOX_ADDR:.*]] = fir.coordinate_of %[[TYPEDESCPTR]], %[[BINDING_FIELD]] : (!fir.ref<[[TYPEINFO]]>, !fir.field) -> !fir.ref<[[BINDING_BOX_TYPE:.*]]> 205! CHECK: %[[BINDING_BOX:.*]] = fir.load %[[BINDING_BOX_ADDR]] : !fir.ref<[[BINDING_BOX_TYPE]]> 206! CHECK: %[[BINDING_BASE_ADDR:.*]] = fir.box_addr %[[BINDING_BOX]] : ([[BINDING_BOX_TYPE]]) -> !fir.ptr<[[BINDINGSINFO:.*]]> 207! CHECK: %[[BINDING_PTR:.*]] = fir.coordinate_of %[[BINDING_BASE_ADDR]], %c2{{.*}} : (!fir.ptr<[[BINDINGSINFO]]>, index) -> !fir.ref<[[BINDINGINFO:.*]]> 208! CHECK: %[[PROC_FIELD:.*]] = fir.field_index proc, [[BINDINGINFO]] 209! CHECK: %[[BUILTIN_FUNC_PTR:.*]] = fir.coordinate_of %[[BINDING_PTR]], %[[PROC_FIELD]] : ({{.*}}) -> !fir.ref<[[BUILTIN_FUNC_TYPE:.*]]> 210! CHECK: %[[ADDRESS_FIELD:.*]] = fir.field_index __address, [[BUILTIN_FUNC_TYPE]] 211! CHECK: %[[FUNC_ADDR_PTR:.*]] = fir.coordinate_of %[[BUILTIN_FUNC_PTR]], %[[ADDRESS_FIELD]] 212! CHECK: %[[FUNC_ADDR:.*]] = fir.load %[[FUNC_ADDR_PTR]] : !fir.ref<i64> 213! CHECK: %[[FUNC_PTR:.*]] = fir.convert %[[FUNC_ADDR]] : (i64) -> (([[CLASS]]) -> ()) 214! CHECK: fir.call %[[FUNC_PTR]](%[[ARG_DECL]]#0) : (!fir.class<!fir.type<_QMdispatch1Tp1{a:i32,b:i32}>>) -> () 215 216! Check dynamic dispatch equal to `call p%display1()` with binding index = 1. 217! CHECK: %[[BOXDESC:.*]] = fir.box_tdesc %[[ARG_DECL]]#0 : ([[CLASS]]) -> !fir.tdesc<none> 218! CHECK: %[[TYPEDESCPTR:.*]] = fir.convert %[[BOXDESC]] : (!fir.tdesc<none>) -> !fir.ref<[[TYPEINFO:!fir.type<_QM__fortran_type_infoTderivedtype{.*}>]]> 219! CHECK: %[[BINDING_FIELD:.*]] = fir.field_index binding, [[TYPEINFO]] 220! CHECK: %[[BINDING_BOX_ADDR:.*]] = fir.coordinate_of %[[TYPEDESCPTR]], %[[BINDING_FIELD]] : (!fir.ref<[[TYPEINFO]]>, !fir.field) -> !fir.ref<[[BINDING_BOX_TYPE:.*]]> 221! CHECK: %[[BINDING_BOX:.*]] = fir.load %[[BINDING_BOX_ADDR]] : !fir.ref<[[BINDING_BOX_TYPE]]> 222! CHECK: %[[BINDING_BASE_ADDR:.*]] = fir.box_addr %[[BINDING_BOX]] : ([[BINDING_BOX_TYPE]]) -> !fir.ptr<[[BINDINGSINFO:.*]]> 223! CHECK: %[[BINDING_PTR:.*]] = fir.coordinate_of %[[BINDING_BASE_ADDR]], %c1{{.*}} : (!fir.ptr<[[BINDINGSINFO]]>, index) -> !fir.ref<[[BINDINGINFO:.*]]> 224! CHECK: %[[PROC_FIELD:.*]] = fir.field_index proc, [[BINDINGINFO]] 225! CHECK: %[[BUILTIN_FUNC_PTR:.*]] = fir.coordinate_of %[[BINDING_PTR]], %[[PROC_FIELD]] : ({{.*}}) -> !fir.ref<[[BUILTIN_FUNC_TYPE:.*]]> 226! CHECK: %[[ADDRESS_FIELD:.*]] = fir.field_index __address, [[BUILTIN_FUNC_TYPE]] 227! CHECK: %[[FUNC_ADDR_PTR:.*]] = fir.coordinate_of %[[BUILTIN_FUNC_PTR]], %[[ADDRESS_FIELD]] 228! CHECK: %[[FUNC_ADDR:.*]] = fir.load %[[FUNC_ADDR_PTR]] : !fir.ref<i64> 229! CHECK: %[[FUNC_PTR:.*]] = fir.convert %[[FUNC_ADDR]] : (i64) -> (([[CLASS]]) -> ()) 230! CHECK: fir.call %[[FUNC_PTR]](%[[ARG_DECL]]#0) : (!fir.class<!fir.type<_QMdispatch1Tp1{a:i32,b:i32}>>) -> () 231 232! Check dynamic dispatch equal to `call p%aproc()` with binding index = 0. 233! CHECK: %[[BOXDESC:.*]] = fir.box_tdesc %[[ARG_DECL]]#0 : ([[CLASS]]) -> !fir.tdesc<none> 234! CHECK: %[[TYPEDESCPTR:.*]] = fir.convert %[[BOXDESC]] : (!fir.tdesc<none>) -> !fir.ref<[[TYPEINFO:!fir.type<_QM__fortran_type_infoTderivedtype{.*}>]]> 235! CHECK: %[[BINDING_FIELD:.*]] = fir.field_index binding, [[TYPEINFO]] 236! CHECK: %[[BINDING_BOX_ADDR:.*]] = fir.coordinate_of %[[TYPEDESCPTR]], %[[BINDING_FIELD]] : (!fir.ref<[[TYPEINFO]]>, !fir.field) -> !fir.ref<[[BINDING_BOX_TYPE:.*]]> 237! CHECK: %[[BINDING_BOX:.*]] = fir.load %[[BINDING_BOX_ADDR]] : !fir.ref<[[BINDING_BOX_TYPE]]> 238! CHECK: %[[BINDING_BASE_ADDR:.*]] = fir.box_addr %[[BINDING_BOX]] : ([[BINDING_BOX_TYPE]]) -> !fir.ptr<[[BINDINGSINFO:.*]]> 239! CHECK: %[[BINDING_PTR:.*]] = fir.coordinate_of %[[BINDING_BASE_ADDR]], %c0{{.*}}: (!fir.ptr<[[BINDINGSINFO]]>, index) -> !fir.ref<[[BINDINGINFO:.*]]> 240! CHECK: %[[PROC_FIELD:.*]] = fir.field_index proc, [[BINDINGINFO]] 241! CHECK: %[[BUILTIN_FUNC_PTR:.*]] = fir.coordinate_of %[[BINDING_PTR]], %[[PROC_FIELD]] : ({{.*}}) -> !fir.ref<[[BUILTIN_FUNC_TYPE:.*]]> 242! CHECK: %[[ADDRESS_FIELD:.*]] = fir.field_index __address, [[BUILTIN_FUNC_TYPE]] 243! CHECK: %[[FUNC_ADDR_PTR:.*]] = fir.coordinate_of %[[BUILTIN_FUNC_PTR]], %[[ADDRESS_FIELD]] 244! CHECK: %[[FUNC_ADDR:.*]] = fir.load %[[FUNC_ADDR_PTR]] : !fir.ref<i64> 245! CHECK: %[[FUNC_PTR:.*]] = fir.convert %[[FUNC_ADDR]] : (i64) -> (([[CLASS]]) -> ()) 246! CHECK: fir.call %[[FUNC_PTR]](%[[ARG_DECL]]#0) : (!fir.class<!fir.type<_QMdispatch1Tp1{a:i32,b:i32}>>) -> () 247 248! Check dynamic dispatch of a function with result. 249! CHECK: %[[BOXDESC:.*]] = fir.box_tdesc %[[ARG_DECL]]#0 : ([[CLASS]]) -> !fir.tdesc<none> 250! CHECK: %[[TYPEDESCPTR:.*]] = fir.convert %[[BOXDESC]] : (!fir.tdesc<none>) -> !fir.ref<[[TYPEINFO:!fir.type<_QM__fortran_type_infoTderivedtype{.*}>]]> 251! CHECK: %[[BINDING_FIELD:.*]] = fir.field_index binding, [[TYPEINFO]] 252! CHECK: %[[BINDING_BOX_ADDR:.*]] = fir.coordinate_of %[[TYPEDESCPTR]], %[[BINDING_FIELD]] : (!fir.ref<[[TYPEINFO]]>, !fir.field) -> !fir.ref<[[BINDING_BOX_TYPE:.*]]> 253! CHECK: %[[BINDING_BOX:.*]] = fir.load %[[BINDING_BOX_ADDR]] : !fir.ref<[[BINDING_BOX_TYPE]]> 254! CHECK: %[[BINDING_BASE_ADDR:.*]] = fir.box_addr %[[BINDING_BOX]] : ([[BINDING_BOX_TYPE]]) -> !fir.ptr<[[BINDINGSINFO:.*]]> 255! CHECK: %[[BINDING_PTR:.*]] = fir.coordinate_of %[[BINDING_BASE_ADDR]], %c3 : (!fir.ptr<[[BINDINGSINFO]]>, index) -> !fir.ref<[[BINDINGINFO:.*]]> 256! CHECK: %[[PROC_FIELD:.*]] = fir.field_index proc, [[BINDINGINFO]] 257! CHECK: %[[BUILTIN_FUNC_PTR:.*]] = fir.coordinate_of %[[BINDING_PTR]], %[[PROC_FIELD]] : ({{.*}}) -> !fir.ref<[[BUILTIN_FUNC_TYPE:.*]]> 258! CHECK: %[[ADDRESS_FIELD:.*]] = fir.field_index __address, [[BUILTIN_FUNC_TYPE]] 259! CHECK: %[[FUNC_ADDR_PTR:.*]] = fir.coordinate_of %[[BUILTIN_FUNC_PTR]], %[[ADDRESS_FIELD]] 260! CHECK: %[[FUNC_ADDR:.*]] = fir.load %[[FUNC_ADDR_PTR]] : !fir.ref<i64> 261! CHECK: %[[FUNC_PTR:.*]] = fir.convert %[[FUNC_ADDR]] : (i64) -> (([[CLASS]]) -> i32) 262! CHECK: %[[RES:.*]] = fir.call %[[FUNC_PTR]](%[[ARG_DECL]]#0) : (!fir.class<!fir.type<_QMdispatch1Tp1{a:i32,b:i32}>>) -> i32 263 264! Check dynamic dispatch of call with passed-object and additional argument 265! CHECK: %[[BOXDESC:.*]] = fir.box_tdesc %[[ARG_DECL]]#0 : ([[CLASS]]) -> !fir.tdesc<none> 266! CHECK: %[[TYPEDESCPTR:.*]] = fir.convert %[[BOXDESC]] : (!fir.tdesc<none>) -> !fir.ref<[[TYPEINFO:!fir.type<_QM__fortran_type_infoTderivedtype{.*}>]]> 267! CHECK: %[[BINDING_FIELD:.*]] = fir.field_index binding, [[TYPEINFO]] 268! CHECK: %[[BINDING_BOX_ADDR:.*]] = fir.coordinate_of %[[TYPEDESCPTR]], %[[BINDING_FIELD]] : (!fir.ref<[[TYPEINFO]]>, !fir.field) -> !fir.ref<[[BINDING_BOX_TYPE:.*]]> 269! CHECK: %[[BINDING_BOX:.*]] = fir.load %[[BINDING_BOX_ADDR]] : !fir.ref<[[BINDING_BOX_TYPE]]> 270! CHECK: %[[BINDING_BASE_ADDR:.*]] = fir.box_addr %[[BINDING_BOX]] : ([[BINDING_BOX_TYPE]]) -> !fir.ptr<[[BINDINGSINFO:.*]]> 271! CHECK: %[[BINDING_PTR:.*]] = fir.coordinate_of %[[BINDING_BASE_ADDR]], %c6{{.*}} : (!fir.ptr<[[BINDINGSINFO]]>, index) -> !fir.ref<[[BINDINGINFO:.*]]> 272! CHECK: %[[PROC_FIELD:.*]] = fir.field_index proc, [[BINDINGINFO]] 273! CHECK: %[[BUILTIN_FUNC_PTR:.*]] = fir.coordinate_of %[[BINDING_PTR]], %[[PROC_FIELD]] : ({{.*}}) -> !fir.ref<[[BUILTIN_FUNC_TYPE:.*]]> 274! CHECK: %[[ADDRESS_FIELD:.*]] = fir.field_index __address, [[BUILTIN_FUNC_TYPE]] 275! CHECK: %[[FUNC_ADDR_PTR:.*]] = fir.coordinate_of %[[BUILTIN_FUNC_PTR]], %[[ADDRESS_FIELD]] 276! CHECK: %[[FUNC_ADDR:.*]] = fir.load %[[FUNC_ADDR_PTR]] : !fir.ref<i64> 277! CHECK: %[[FUNC_PTR:.*]] = fir.convert %[[FUNC_ADDR]] : (i64) -> (([[CLASS]], !fir.ref<f32>) -> ()) 278! CHECK: fir.call %[[FUNC_PTR]](%[[ARG_DECL]]#0, %{{.*}}) : (!fir.class<!fir.type<_QMdispatch1Tp1{a:i32,b:i32}>>, !fir.ref<f32>) -> () 279 280! Check dynamic dispatch of a call with NOPASS 281! CHECK: %[[BOXDESC:.*]] = fir.box_tdesc %[[ARG_DECL]]#1 : ([[CLASS]]) -> !fir.tdesc<none> 282! CHECK: %[[TYPEDESCPTR:.*]] = fir.convert %[[BOXDESC]] : (!fir.tdesc<none>) -> !fir.ref<[[TYPEINFO:!fir.type<_QM__fortran_type_infoTderivedtype{.*}>]]> 283! CHECK: %[[BINDING_FIELD:.*]] = fir.field_index binding, [[TYPEINFO]] 284! CHECK: %[[BINDING_BOX_ADDR:.*]] = fir.coordinate_of %[[TYPEDESCPTR]], %[[BINDING_FIELD]] : (!fir.ref<[[TYPEINFO]]>, !fir.field) -> !fir.ref<[[BINDING_BOX_TYPE:.*]]> 285! CHECK: %[[BINDING_BOX:.*]] = fir.load %[[BINDING_BOX_ADDR]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<{{.*}}>>>>> 286! CHECK: %[[BINDING_BASE_ADDR:.*]] = fir.box_addr %[[BINDING_BOX]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.type<{{.*}}>>> 287! CHECK: %[[BINDING_PTR:.*]] = fir.coordinate_of %[[BINDING_BASE_ADDR]], %c4{{.*}} : (!fir.ptr<!fir.array<?x!fir.type<{{.*}}>>>, index) -> !fir.ref<!fir.type<{{.*}}>> 288! CHECK: %[[PROC_FIELD:.*]] = fir.field_index proc, [[BINDINGINFO]] 289! CHECK: %[[BUILTIN_FUNC_PTR:.*]] = fir.coordinate_of %[[BINDING_PTR]], %[[PROC_FIELD]] : ({{.*}}) -> !fir.ref<[[BUILTIN_FUNC_TYPE:.*]]> 290! CHECK: %[[ADDRESS_FIELD:.*]] = fir.field_index __address, [[BUILTIN_FUNC_TYPE]] 291! CHECK: %[[FUNC_ADDR_PTR:.*]] = fir.coordinate_of %[[BUILTIN_FUNC_PTR]], %[[ADDRESS_FIELD]] 292! CHECK: %[[FUNC_ADDR:.*]] = fir.load %[[FUNC_ADDR_PTR]] : !fir.ref<i64> 293! CHECK: %[[FUNC_PTR:.*]] = fir.convert %[[FUNC_ADDR]] : (i64) -> (() -> ()) 294! CHECK: fir.call %[[FUNC_PTR]]() : () -> () 295 296! CHECK: %[[BOXDESC:.*]] = fir.box_tdesc %[[ARG_DECL]]#0 : ([[CLASS]]) -> !fir.tdesc<none> 297! CHECK: %[[TYPEDESCPTR:.*]] = fir.convert %[[BOXDESC]] : (!fir.tdesc<none>) -> !fir.ref<[[TYPEINFO:!fir.type<_QM__fortran_type_infoTderivedtype{.*}>]]> 298! CHECK: %[[BINDING_FIELD:.*]] = fir.field_index binding, [[TYPEINFO]] 299! CHECK: %[[BINDING_BOX_ADDR:.*]] = fir.coordinate_of %[[TYPEDESCPTR]], %[[BINDING_FIELD]] : (!fir.ref<[[TYPEINFO]]>, !fir.field) -> !fir.ref<[[BINDING_BOX_TYPE:.*]]> 300! CHECK: %[[BINDING_BOX:.*]] = fir.load %[[BINDING_BOX_ADDR]] : !fir.ref<[[BINDING_BOX_TYPE]]> 301! CHECK: %[[BINDING_BASE_ADDR:.*]] = fir.box_addr %[[BINDING_BOX]] : ([[BINDING_BOX_TYPE]]) -> !fir.ptr<[[BINDINGSINFO:.*]]> 302! CHECK: %[[BINDING_PTR:.*]] = fir.coordinate_of %[[BINDING_BASE_ADDR]], %c5{{.*}} : (!fir.ptr<[[BINDINGSINFO]]>, index) -> !fir.ref<[[BINDINGINFO:.*]]> 303! CHECK: %[[PROC_FIELD:.*]] = fir.field_index proc, [[BINDINGINFO]] 304! CHECK: %[[BUILTIN_FUNC_PTR:.*]] = fir.coordinate_of %[[BINDING_PTR]], %[[PROC_FIELD]] : ({{.*}}) -> !fir.ref<[[BUILTIN_FUNC_TYPE:.*]]> 305! CHECK: %[[ADDRESS_FIELD:.*]] = fir.field_index __address, [[BUILTIN_FUNC_TYPE]] 306! CHECK: %[[FUNC_ADDR_PTR:.*]] = fir.coordinate_of %[[BUILTIN_FUNC_PTR]], %[[ADDRESS_FIELD]] 307! CHECK: %[[FUNC_ADDR:.*]] = fir.load %[[FUNC_ADDR_PTR]] : !fir.ref<i64> 308! CHECK: %[[FUNC_PTR:.*]] = fir.convert %[[FUNC_ADDR]] : (i64) -> ((!fir.ref<i32>, [[CLASS]]) -> ()) 309! CHECK: fir.call %[[FUNC_PTR]](%{{.*}}, %[[ARG_DECL]]#0) : (!fir.ref<i32>, [[CLASS]]) -> () 310 311! Test attributes are propagated from fir.dispatch to fir.call 312! for `call p%z_proc_nopass_bindc()` 313! CHECK: fir.call %{{.*}}() proc_attrs<bind_c> : () -> () 314 315! CHECK-LABEL: _QMdispatch1Pno_pass_array 316! CHECK-LABEL: _QMdispatch1Pno_pass_array_allocatable 317! CHECK-LABEL: _QMdispatch1Pno_pass_array_pointer 318! CHECK-LABEL: _QMdispatch1Pcall_a1_proc 319 320! Check the layout of the binding table. This is easier to do in FIR than in 321! LLVM IR. 322 323! BT-LABEL: fir.type_info @_QMdispatch1Tty_kindK10K20 324! BT-LABEL: fir.type_info @_QMdispatch1Tty_kind_exK10K20 {{.*}}extends !fir.type<_QMdispatch1Tty_kindK10K20{{.*}}> 325 326! BT-LABEL: fir.type_info @_QMdispatch1Tp1 327! BT: fir.dt_entry "aproc", @_QMdispatch1Paproc 328! BT: fir.dt_entry "display1", @_QMdispatch1Pdisplay1_p1 329! BT: fir.dt_entry "display2", @_QMdispatch1Pdisplay2_p1 330! BT: fir.dt_entry "get_value", @_QMdispatch1Pget_value_p1 331! BT: fir.dt_entry "proc_nopass", @_QMdispatch1Pproc_nopass_p1 332! BT: fir.dt_entry "proc_pass", @_QMdispatch1Pproc_pass_p1 333! BT: fir.dt_entry "proc_with_values", @_QMdispatch1Pproc_p1 334! BT: fir.dt_entry "z_proc_nopass_bindc", @proc_nopass_bindc_p1 335! BT: } 336 337! BT-LABEL: fir.type_info @_QMdispatch1Ta1 338! BT: fir.dt_entry "a1_proc", @_QMdispatch1Pa1_proc 339! BT: } 340 341! BT-LABEL: fir.type_info @_QMdispatch1Ta2 {{.*}}extends !fir.type<_QMdispatch1Ta1{{.*}}> 342! BT: fir.dt_entry "a1_proc", @_QMdispatch1Pa2_proc 343! BT: } 344 345! BT-LABEL: fir.type_info @_QMdispatch1Tp2 {{.*}}extends !fir.type<_QMdispatch1Tp1{{.*}}> 346! BT: fir.dt_entry "aproc", @_QMdispatch1Paproc 347! BT: fir.dt_entry "display1", @_QMdispatch1Pdisplay1_p2 348! BT: fir.dt_entry "display2", @_QMdispatch1Pdisplay2_p2 349! BT: fir.dt_entry "get_value", @_QMdispatch1Pget_value_p2 350! BT: fir.dt_entry "proc_nopass", @_QMdispatch1Pproc_nopass_p2 351! BT: fir.dt_entry "proc_pass", @_QMdispatch1Pproc_pass_p2 352! BT: fir.dt_entry "proc_with_values", @_QMdispatch1Pproc_p2 353! BT: fir.dt_entry "z_proc_nopass_bindc", @proc_nopass_bindc_p2 354! BT: fir.dt_entry "display3", @_QMdispatch1Pdisplay3 355! BT: } 356