41 lines · plain
1! Test C_F_PROCPOINTER() lowering.2! RUN: bbc -emit-hlfir -o - %s | FileCheck %s3 4subroutine test_c_funloc(fptr, cptr)5 use iso_c_binding, only : c_f_procpointer, c_funptr6 real, pointer, external :: fptr7 type(c_funptr), cptr8 call c_f_procpointer(cptr, fptr)9end subroutine10! CHECK-LABEL: func.func @_QPtest_c_funloc(11! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.boxproc<() -> ()>>,12! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>> {fir.bindc_name = "cptr"}) {13! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {uniq_name = "_QFtest_c_funlocEcptr"} : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>, !fir.dscope) -> (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>, !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>)14! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_c_funlocEfptr"} : (!fir.ref<!fir.boxproc<() -> ()>>, !fir.dscope) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)15! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_2]]#0, __address : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>) -> !fir.ref<i64>16! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.ref<i64>17! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> (() -> ())18! CHECK: %[[VAL_8:.*]] = fir.emboxproc %[[VAL_7]] : (() -> ()) -> !fir.boxproc<() -> ()>19! CHECK: fir.store %[[VAL_8]] to %[[VAL_3]]#0 : !fir.ref<!fir.boxproc<() -> ()>>20 21subroutine test_c_funloc_char(fptr, cptr)22 use iso_c_binding, only : c_f_procpointer, c_funptr23 interface24 character(10) function char_func()25 end function26 end interface27 procedure(char_func), pointer :: fptr28 type(c_funptr), cptr29 call c_f_procpointer(cptr, fptr)30end subroutine31! CHECK-LABEL: func.func @_QPtest_c_funloc_char(32! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.boxproc<() -> ()>>,33! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>> {fir.bindc_name = "cptr"}) {34! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {uniq_name = "_QFtest_c_funloc_charEcptr"} : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>, !fir.dscope) -> (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>, !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>)35! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} arg {{[0-9]+}} {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_c_funloc_charEfptr"} : (!fir.ref<!fir.boxproc<() -> ()>>, !fir.dscope) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)36! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_2]]#0, __address : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>) -> !fir.ref<i64>37! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.ref<i64>38! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> (() -> ())39! CHECK: %[[VAL_8:.*]] = fir.emboxproc %[[VAL_7]] : (() -> ()) -> !fir.boxproc<() -> ()>40! CHECK: fir.store %[[VAL_8]] to %[[VAL_3]]#0 : !fir.ref<!fir.boxproc<() -> ()>>41