flang/test/Lower/Intrinsics/associated-proc-pointers.f90

   1 ! Test ASSOCIATED() with procedure pointers.
   2 ! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
   3
   4 subroutine test_proc_pointer_1(p, dummy_proc)
   5   procedure(), pointer :: p
   6   procedure() :: dummy_proc
   7   call takes_log(associated(p, dummy_proc))
   8 end subroutine
   9 ! CHECK-LABEL:   func.func @_QPtest_proc_pointer_1(
  10 ! CHECK-SAME:                                      %[[VAL_0:.*]]: !fir.ref<!fir.boxproc<() -> ()>>,
  11 ! CHECK-SAME:                                      %[[VAL_1:.*]]: !fir.boxproc<() -> ()>) {
  12 ! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_proc_pointer_1Ep"} : (!fir.ref<!fir.boxproc<() -> ()>>, !fir.dscope) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
  13 ! CHECK:           %[[VAL_3:.*]] = fir.load %[[VAL_2]]#1 : !fir.ref<!fir.boxproc<() -> ()>>
  14 ! CHECK:           %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.boxproc<() -> ()>) -> (() -> ())
  15 ! CHECK:           %[[VAL_5:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ())
  16 ! CHECK:           %[[VAL_6:.*]] = fir.convert %[[VAL_4]] : (() -> ()) -> i64
  17 ! CHECK:           %[[VAL_7:.*]] = fir.convert %[[VAL_5]] : (() -> ()) -> i64
  18 ! CHECK:           %[[VAL_8:.*]] = arith.cmpi eq, %[[VAL_6]], %[[VAL_7]] : i64
  19 ! CHECK:           %[[VAL_9:.*]] = arith.constant 0 : i64
  20 ! CHECK:           %[[VAL_10:.*]] = arith.cmpi ne, %[[VAL_9]], %[[VAL_6]] : i64
  21 ! CHECK:           %[[VAL_11:.*]] = arith.andi %[[VAL_8]], %[[VAL_10]] : i1
  22 ! CHECK:           %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i1) -> !fir.logical<4>
  23
  24 subroutine test_proc_pointer_2(p, p_target)
  25   procedure(), pointer :: p, p_target
  26   call takes_log(associated(p, p_target))
  27 end subroutine
  28 ! CHECK-LABEL:   func.func @_QPtest_proc_pointer_2(
  29 ! CHECK-SAME:                                      %[[VAL_0:.*]]: !fir.ref<!fir.boxproc<() -> ()>>,
  30 ! CHECK-SAME:                                      %[[VAL_1:.*]]: !fir.ref<!fir.boxproc<() -> ()>>) {
  31 ! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_proc_pointer_2Ep"} : (!fir.ref<!fir.boxproc<() -> ()>>, !fir.dscope) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
  32 ! CHECK:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_proc_pointer_2Ep_target"} : (!fir.ref<!fir.boxproc<() -> ()>>, !fir.dscope) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
  33 ! CHECK:           %[[VAL_4:.*]] = fir.load %[[VAL_2]]#1 : !fir.ref<!fir.boxproc<() -> ()>>
  34 ! CHECK:           %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> (() -> ())
  35 ! CHECK:           %[[VAL_6:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.boxproc<() -> ()>>
  36 ! CHECK:           %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.boxproc<() -> ()>) -> (() -> ())
  37 ! CHECK:           %[[VAL_8:.*]] = fir.convert %[[VAL_5]] : (() -> ()) -> i64
  38 ! CHECK:           %[[VAL_9:.*]] = fir.convert %[[VAL_7]] : (() -> ()) -> i64
  39 ! CHECK:           %[[VAL_10:.*]] = arith.cmpi eq, %[[VAL_8]], %[[VAL_9]] : i64
  40 ! CHECK:           %[[VAL_11:.*]] = arith.constant 0 : i64
  41 ! CHECK:           %[[VAL_12:.*]] = arith.cmpi ne, %[[VAL_11]], %[[VAL_8]] : i64
  42 ! CHECK:           %[[VAL_13:.*]] = arith.andi %[[VAL_10]], %[[VAL_12]] : i1
  43 ! CHECK:           %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i1) -> !fir.logical<4>
  44
  45 subroutine test_proc_pointer_3(p, dummy_proc)
  46   procedure(), pointer :: p
  47   procedure(), optional :: dummy_proc
  48   call takes_log(associated(p, dummy_proc))
  49 end subroutine
  50 ! CHECK-LABEL:   func.func @_QPtest_proc_pointer_3(
  51 ! CHECK-SAME:                                      %[[VAL_0:.*]]: !fir.ref<!fir.boxproc<() -> ()>>,
  52 ! CHECK-SAME:                                      %[[VAL_1:.*]]: !fir.boxproc<() -> ()>) {
  53 ! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_proc_pointer_3Ep"} : (!fir.ref<!fir.boxproc<() -> ()>>, !fir.dscope) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
  54 ! CHECK:           %[[VAL_3:.*]] = fir.load %[[VAL_2]]#1 : !fir.ref<!fir.boxproc<() -> ()>>
  55 ! CHECK:           %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.boxproc<() -> ()>) -> (() -> ())
  56 ! CHECK:           %[[VAL_5:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ())
  57 ! CHECK:           %[[VAL_6:.*]] = fir.convert %[[VAL_4]] : (() -> ()) -> i64
  58 ! CHECK:           %[[VAL_7:.*]] = fir.convert %[[VAL_5]] : (() -> ()) -> i64
  59 ! CHECK:           %[[VAL_8:.*]] = arith.cmpi eq, %[[VAL_6]], %[[VAL_7]] : i64
  60 ! CHECK:           %[[VAL_9:.*]] = arith.constant 0 : i64
  61 ! CHECK:           %[[VAL_10:.*]] = arith.cmpi ne, %[[VAL_9]], %[[VAL_6]] : i64
  62 ! CHECK:           %[[VAL_11:.*]] = arith.andi %[[VAL_8]], %[[VAL_10]] : i1
  63 ! CHECK:           %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i1) -> !fir.logical<4>
  64
  65 subroutine test_proc_pointer_4(p)
  66   procedure(), pointer :: p
  67   external :: some_external
  68   call takes_log(associated(p, some_external))
  69 end subroutine
  70 ! CHECK-LABEL:   func.func @_QPtest_proc_pointer_4(
  71 ! CHECK-SAME:                                      %[[VAL_0:.*]]: !fir.ref<!fir.boxproc<() -> ()>>) {
  72 ! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_proc_pointer_4Ep"} : (!fir.ref<!fir.boxproc<() -> ()>>, !fir.dscope) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
  73 ! CHECK:           %[[VAL_2:.*]] = fir.address_of(@_QPsome_external) : () -> ()
  74 ! CHECK:           %[[VAL_3:.*]] = fir.emboxproc %[[VAL_2]] : (() -> ()) -> !fir.boxproc<() -> ()>
  75 ! CHECK:           %[[VAL_4:.*]] = fir.load %[[VAL_1]]#1 : !fir.ref<!fir.boxproc<() -> ()>>
  76 ! CHECK:           %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> (() -> ())
  77 ! CHECK:           %[[VAL_6:.*]] = fir.box_addr %[[VAL_3]] : (!fir.boxproc<() -> ()>) -> (() -> ())
  78 ! CHECK:           %[[VAL_7:.*]] = fir.convert %[[VAL_5]] : (() -> ()) -> i64
  79 ! CHECK:           %[[VAL_8:.*]] = fir.convert %[[VAL_6]] : (() -> ()) -> i64
  80 ! CHECK:           %[[VAL_9:.*]] = arith.cmpi eq, %[[VAL_7]], %[[VAL_8]] : i64
  81 ! CHECK:           %[[VAL_10:.*]] = arith.constant 0 : i64
  82 ! CHECK:           %[[VAL_11:.*]] = arith.cmpi ne, %[[VAL_10]], %[[VAL_7]] : i64
  83 ! CHECK:           %[[VAL_12:.*]] = arith.andi %[[VAL_9]], %[[VAL_11]] : i1
  84 ! CHECK:           %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (i1) -> !fir.logical<4>
  85
  86 subroutine test_proc_pointer_5(p, dummy_proc)
  87   interface
  88     character(10) function char_func()
  89     end function
  90   end interface
  91   procedure(char_func), pointer :: p
  92   procedure(char_func) :: dummy_proc
  93   call takes_log(associated(p, dummy_proc))
  94 end subroutine
  95 ! CHECK-LABEL:   func.func @_QPtest_proc_pointer_5(
  96 ! CHECK-SAME:                                      %[[VAL_0:.*]]: !fir.ref<!fir.boxproc<() -> ()>>,
  97 ! CHECK-SAME:                                      %[[VAL_1:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
  98 ! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_proc_pointer_5Ep"} : (!fir.ref<!fir.boxproc<() -> ()>>, !fir.dscope) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
  99 ! CHECK:           %[[VAL_3:.*]] = fir.extract_value %[[VAL_1]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
 100 ! CHECK:           %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.boxproc<() -> ()>) -> (() -> ())
 101 ! CHECK:           %[[VAL_5:.*]] = arith.constant 10 : i64
 102 ! CHECK:           %[[VAL_6:.*]] = fir.emboxproc %[[VAL_4]] : (() -> ()) -> !fir.boxproc<() -> ()>
 103 ! CHECK:           %[[VAL_7:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
 104 ! CHECK:           %[[VAL_8:.*]] = fir.insert_value %[[VAL_7]], %[[VAL_6]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
 105 ! CHECK:           %[[VAL_9:.*]] = fir.insert_value %[[VAL_8]], %[[VAL_5]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
 106 ! CHECK:           %[[VAL_10:.*]] = fir.extract_value %[[VAL_9]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
 107 ! CHECK:           %[[VAL_11:.*]] = fir.load %[[VAL_2]]#1 : !fir.ref<!fir.boxproc<() -> ()>>
 108 ! CHECK:           %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.boxproc<() -> ()>) -> (() -> ())
 109 ! CHECK:           %[[VAL_13:.*]] = fir.box_addr %[[VAL_10]] : (!fir.boxproc<() -> ()>) -> (() -> ())
 110 ! CHECK:           %[[VAL_14:.*]] = fir.convert %[[VAL_12]] : (() -> ()) -> i64
 111 ! CHECK:           %[[VAL_15:.*]] = fir.convert %[[VAL_13]] : (() -> ()) -> i64
 112 ! CHECK:           %[[VAL_16:.*]] = arith.cmpi eq, %[[VAL_14]], %[[VAL_15]] : i64
 113 ! CHECK:           %[[VAL_17:.*]] = arith.constant 0 : i64
 114 ! CHECK:           %[[VAL_18:.*]] = arith.cmpi ne, %[[VAL_17]], %[[VAL_14]] : i64
 115 ! CHECK:           %[[VAL_19:.*]] = arith.andi %[[VAL_16]], %[[VAL_18]] : i1
 116 ! CHECK:           %[[VAL_20:.*]] = fir.convert %[[VAL_19]] : (i1) -> !fir.logical<4>
 117
 118 subroutine test_proc_pointer_6()
 119   interface
 120     real function func()
 121     end
 122   end interface
 123   logical :: ll
 124   ll = associated(reffunc(), func)
 125 contains
 126   function reffunc() result(pp)
 127     procedure(func), pointer :: pp
 128   end
 129 end
 130 ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.logical<4> {bindc_name = "ll", uniq_name = "_QFtest_proc_pointer_6Ell"}
 131 ! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest_proc_pointer_6Ell"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)
 132 ! CHECK: %[[VAL_2:.*]] = fir.call @_QFtest_proc_pointer_6Preffunc() fastmath<contract> : () -> !fir.boxproc<() -> f32>
 133 ! CHECK: %[[VAL_3:.*]] = fir.address_of(@_QPfunc) : () -> f32
 134 ! CHECK: %[[VAL_4:.*]] = fir.emboxproc %[[VAL_3]] : (() -> f32) -> !fir.boxproc<() -> ()>
 135 ! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_2]] : (!fir.boxproc<() -> f32>) -> (() -> f32)
 136 ! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> (() -> ())
 137 ! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_5]] : (() -> f32) -> i64
 138 ! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_6]] : (() -> ()) -> i64
 139 ! CHECK: %[[VAL_9:.*]] = arith.cmpi eq, %[[VAL_7]], %[[VAL_8]] : i64
 140 ! CHECK: %c0_i64 = arith.constant 0 : i64
 141 ! CHECK: %[[VAL_10:.*]] = arith.cmpi ne, %c0_i64, %[[VAL_7]] : i64
 142 ! CHECK: %[[VAL_11:.*]] = arith.andi %[[VAL_9]], %[[VAL_10]] : i1
 143 ! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i1) -> !fir.logical<4>
 144 ! CHECK: hlfir.assign %[[VAL_12]] to %[[VAL_1]]#0 : !fir.logical<4>, !fir.ref<!fir.logical<4>>