145 lines · plain
1! Test ASSOCIATED() with procedure pointers.2! RUN: bbc -emit-hlfir -o - %s | FileCheck %s3 4subroutine test_proc_pointer_1(p, dummy_proc)5 procedure(), pointer :: p6 procedure() :: dummy_proc7 call takes_log(associated(p, dummy_proc))8end subroutine9! 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]+}} arg {{[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]]#0 : !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]] : (() -> ()) -> i6417! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_5]] : (() -> ()) -> i6418! CHECK: %[[VAL_8:.*]] = arith.cmpi eq, %[[VAL_6]], %[[VAL_7]] : i6419! CHECK: %[[VAL_9:.*]] = arith.constant 0 : i6420! CHECK: %[[VAL_10:.*]] = arith.cmpi ne, %[[VAL_9]], %[[VAL_6]] : i6421! CHECK: %[[VAL_11:.*]] = arith.andi %[[VAL_8]], %[[VAL_10]] : i122! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i1) -> !fir.logical<4>23 24subroutine test_proc_pointer_2(p, p_target)25 procedure(), pointer :: p, p_target26 call takes_log(associated(p, p_target))27end subroutine28! 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]+}} arg {{[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]+}} arg {{[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]]#0 : !fir.ref<!fir.boxproc<() -> ()>>34! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> (() -> ())35! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<!fir.boxproc<() -> ()>>36! CHECK: %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.boxproc<() -> ()>) -> (() -> ())37! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_5]] : (() -> ()) -> i6438! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_7]] : (() -> ()) -> i6439! CHECK: %[[VAL_10:.*]] = arith.cmpi eq, %[[VAL_8]], %[[VAL_9]] : i6440! CHECK: %[[VAL_11:.*]] = arith.constant 0 : i6441! CHECK: %[[VAL_12:.*]] = arith.cmpi ne, %[[VAL_11]], %[[VAL_8]] : i6442! CHECK: %[[VAL_13:.*]] = arith.andi %[[VAL_10]], %[[VAL_12]] : i143! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i1) -> !fir.logical<4>44 45subroutine test_proc_pointer_3(p, dummy_proc)46 procedure(), pointer :: p47 procedure(), optional :: dummy_proc48 call takes_log(associated(p, dummy_proc))49end subroutine50! 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]+}} arg {{[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]]#0 : !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]] : (() -> ()) -> i6458! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_5]] : (() -> ()) -> i6459! CHECK: %[[VAL_8:.*]] = arith.cmpi eq, %[[VAL_6]], %[[VAL_7]] : i6460! CHECK: %[[VAL_9:.*]] = arith.constant 0 : i6461! CHECK: %[[VAL_10:.*]] = arith.cmpi ne, %[[VAL_9]], %[[VAL_6]] : i6462! CHECK: %[[VAL_11:.*]] = arith.andi %[[VAL_8]], %[[VAL_10]] : i163! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i1) -> !fir.logical<4>64 65subroutine test_proc_pointer_4(p)66 procedure(), pointer :: p67 external :: some_external68 call takes_log(associated(p, some_external))69end subroutine70! 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]+}} arg {{[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]]#0 : !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]] : (() -> ()) -> i6479! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_6]] : (() -> ()) -> i6480! CHECK: %[[VAL_9:.*]] = arith.cmpi eq, %[[VAL_7]], %[[VAL_8]] : i6481! CHECK: %[[VAL_10:.*]] = arith.constant 0 : i6482! CHECK: %[[VAL_11:.*]] = arith.cmpi ne, %[[VAL_10]], %[[VAL_7]] : i6483! CHECK: %[[VAL_12:.*]] = arith.andi %[[VAL_9]], %[[VAL_11]] : i184! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (i1) -> !fir.logical<4>85 86subroutine test_proc_pointer_5(p, dummy_proc)87 interface88 character(10) function char_func()89 end function90 end interface91 procedure(char_func), pointer :: p92 procedure(char_func) :: dummy_proc93 call takes_log(associated(p, dummy_proc))94end subroutine95! 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]+}} arg {{[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 : i64102! 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]]#0 : !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]] : (() -> ()) -> i64111! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_13]] : (() -> ()) -> i64112! CHECK: %[[VAL_16:.*]] = arith.cmpi eq, %[[VAL_14]], %[[VAL_15]] : i64113! CHECK: %[[VAL_17:.*]] = arith.constant 0 : i64114! CHECK: %[[VAL_18:.*]] = arith.cmpi ne, %[[VAL_17]], %[[VAL_14]] : i64115! CHECK: %[[VAL_19:.*]] = arith.andi %[[VAL_16]], %[[VAL_18]] : i1116! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_19]] : (i1) -> !fir.logical<4>117 118subroutine test_proc_pointer_6()119 interface120 real function func()121 end122 end interface123 logical :: ll124 ll = associated(reffunc(), func)125contains126 function reffunc() result(pp)127 procedure(func), pointer :: pp128 end129end130! 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) : () -> f32134! 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) -> i64138! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_6]] : (() -> ()) -> i64139! CHECK: %[[VAL_9:.*]] = arith.cmpi eq, %[[VAL_7]], %[[VAL_8]] : i64140! CHECK: %c0_i64 = arith.constant 0 : i64141! CHECK: %[[VAL_10:.*]] = arith.cmpi ne, %c0_i64, %[[VAL_7]] : i64142! CHECK: %[[VAL_11:.*]] = arith.andi %[[VAL_9]], %[[VAL_10]] : i1143! 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>>145