123 lines · plain
1! Test lowering of NOPASS procedure pointers components.2! RUN: bbc -emit-hlfir -o - %s | FileCheck %s3 4module proc_comp_defs5 interface6 real function iface(x)7 real :: x8 end function9 subroutine takes_proc_pointer(p)10 import iface11 procedure(iface), pointer :: p12 end subroutine13 end interface14 type t15 integer :: j16 procedure(iface), nopass, pointer :: p17 end type18end module19 20real function test1(x)21 use proc_comp_defs, only : t22 type(t) :: x23 test1 = x%p(42.)24end function25! CHECK-LABEL: func.func @_QPtest1(26! CHECK: %[[VAL_1:.*]] = fir.alloca f32 {bindc_name = "test1", uniq_name = "_QFtest1Etest1"}27! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {{.*}}Etest128! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex29! CHECK: %[[VAL_4:.*]] = arith.constant 4.200000e+01 : f3230! CHECK: %[[VAL_5:.*]]:3 = hlfir.associate %[[VAL_4]] {adapt.valuebyref} : (f32) -> (!fir.ref<f32>, !fir.ref<f32>, i1)31! CHECK: %[[VAL_6:.*]] = hlfir.designate %[[VAL_3]]#0{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>32! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_6]] : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>33! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.boxproc<(!fir.ref<f32>) -> f32>) -> ((!fir.ref<f32>) -> f32)34! CHECK: %[[VAL_9:.*]] = fir.call %[[VAL_8]](%[[VAL_5]]#0) fastmath<contract> : (!fir.ref<f32>) -> f3235! CHECK: hlfir.assign %[[VAL_9]] to %[[VAL_2]]#0 : f32, !fir.ref<f32>36! CHECK: hlfir.end_associate %[[VAL_5]]#1, %[[VAL_5]]#2 : !fir.ref<f32>, i137 38subroutine test2(x)39 use proc_comp_defs, only : t, iface40 type(t) :: x41 procedure(iface) :: ptarget42 x%p => ptarget43end subroutine44! CHECK-LABEL: func.func @_QPtest2(45! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex46! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>47! CHECK: %[[VAL_3:.*]] = fir.address_of(@_QPptarget) : (!fir.ref<f32>) -> f3248! CHECK: %[[VAL_4:.*]] = fir.emboxproc %[[VAL_3]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<() -> ()>49! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<f32>) -> f32>50! CHECK: fir.store %[[VAL_5]] to %[[VAL_2]] : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>51 52subroutine test3(x)53 use proc_comp_defs, only : t54 type(t) :: x55 x%p => null()56end subroutine57! CHECK-LABEL: func.func @_QPtest3(58! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex59! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>60! CHECK: %[[VAL_3:.*]] = fir.zero_bits (!fir.ref<f32>) -> f3261! CHECK: %[[VAL_4:.*]] = fir.emboxproc %[[VAL_3]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<(!fir.ref<f32>) -> f32>62! CHECK: fir.store %[[VAL_4]] to %[[VAL_2]] : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>63 64subroutine test4(x)65 use proc_comp_defs, only : t66 type(t) :: x67 x%p => x%p68end subroutine69! CHECK-LABEL: func.func @_QPtest4(70! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex71! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>72! CHECK: %[[VAL_3:.*]] = hlfir.designate %[[VAL_1]]#0{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>73! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>74! CHECK: fir.store %[[VAL_4]] to %[[VAL_2]] : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>75 76subroutine test5(x)77 use proc_comp_defs, only : t, takes_proc_pointer78 type(t) :: x79 call takes_proc_pointer(x%p)80end subroutine81! CHECK-LABEL: func.func @_QPtest5(82! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex83! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>84! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>) -> !fir.ref<!fir.boxproc<() -> ()>>85! CHECK: fir.call @_QPtakes_proc_pointer(%[[VAL_3]]) fastmath<contract> : (!fir.ref<!fir.boxproc<() -> ()>>) -> ()86 87subroutine test6(x)88 use proc_comp_defs, only : t89 type(t) :: x90 nullify(x%p)91end subroutine92! CHECK-LABEL: func.func @_QPtest6(93! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex94! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>) -> !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>95! CHECK: %[[VAL_3:.*]] = fir.zero_bits () -> ()96! CHECK: %[[VAL_4:.*]] = fir.emboxproc %[[VAL_3]] : (() -> ()) -> !fir.boxproc<() -> ()>97! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<f32>) -> f32>98! CHECK: fir.store %[[VAL_5]] to %[[VAL_2]] : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>99 100subroutine test7(x, y)101 use proc_comp_defs, only : t102 type(t) :: x, y103 x = y104end subroutine105! CHECK-LABEL: func.func @_QPtest7(106! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex107! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {{.*}}Ey108! CHECK: hlfir.assign %[[VAL_3]]#0 to %[[VAL_2]]#0 : !fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>, !fir.ref<!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>109 110subroutine test8(x, y)111 use proc_comp_defs, only : t112 type(t) :: x(10), y(10)113 x = y114end subroutine115! CHECK-LABEL: func.func @_QPtest8(116! CHECK: %[[VAL_2:.*]] = arith.constant 10 : index117! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>118! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_3:[a-z0-9]*]]) {{.*}}Ex119! CHECK: %[[VAL_5:.*]] = arith.constant 10 : index120! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>121! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]](%[[VAL_6:[a-z0-9]*]]) {{.*}}Ey122! CHECK: hlfir.assign %[[VAL_7]]#0 to %[[VAL_4]]#0 : !fir.ref<!fir.array<10x!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>>, !fir.ref<!fir.array<10x!fir.type<_QMproc_comp_defsTt{j:i32,p:!fir.boxproc<(!fir.ref<f32>) -> f32>}>>>123