flang/test/Fir/dispatch.f90

   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
   8 module 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
  59 contains
  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
 184 end module
 185
 186 program 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)
 193 end
 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: }