1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
|
! Test calls with POINTER dummy arguments on the caller side.
! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s
module call_defs
interface
subroutine scalar_ptr(p)
integer, pointer, intent(in) :: p
end subroutine
subroutine array_ptr(p)
integer, pointer, intent(in) :: p(:)
end subroutine
subroutine char_array_ptr(p)
character(:), pointer, intent(in) :: p(:)
end subroutine
subroutine non_deferred_char_array_ptr(p)
character(10), pointer, intent(in) :: p(:)
end subroutine
end interface
contains
! -----------------------------------------------------------------------------
! Test passing POINTER actual arguments
! -----------------------------------------------------------------------------
! CHECK-LABEL: func @_QMcall_defsPtest_ptr_to_scalar_ptr(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<i32>>> {fir.bindc_name = "p"}) {
subroutine test_ptr_to_scalar_ptr(p)
integer, pointer :: p
! CHECK: fir.call @_QPscalar_ptr(%[[VAL_0]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<i32>>>) -> ()
call scalar_ptr(p)
end subroutine
! CHECK-LABEL: func @_QMcall_defsPtest_ptr_to_array_ptr(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>> {fir.bindc_name = "p"}) {
subroutine test_ptr_to_array_ptr(p)
integer, pointer :: p(:)
call array_ptr(p)
end subroutine
! CHECK-LABEL: func @_QMcall_defsPtest_ptr_to_char_array_ptr(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>> {fir.bindc_name = "p"}) {
subroutine test_ptr_to_char_array_ptr(p)
character(:), pointer :: p(:)
! CHECK: fir.call @_QPchar_array_ptr(%[[VAL_0]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> ()
call char_array_ptr(p)
end subroutine
! CHECK-LABEL: func @_QMcall_defsPtest_ptr_to_non_deferred_char_array_ptr(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>> {fir.bindc_name = "p"}
subroutine test_ptr_to_non_deferred_char_array_ptr(p, n)
integer :: n
character(n), pointer :: p(:)
! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>>
! CHECK: fir.call @_QPnon_deferred_char_array_ptr(%[[VAL_1]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>>) -> ()
call non_deferred_char_array_ptr(p)
end subroutine
! -----------------------------------------------------------------------------
! Test passing non-POINTER actual arguments (implicit pointer assignment)
! -----------------------------------------------------------------------------
! CHECK-LABEL: func @_QMcall_defsPtest_non_ptr_to_scalar_ptr(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "p", fir.target}) {
subroutine test_non_ptr_to_scalar_ptr(p)
integer, target :: p
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<i32>>
! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<i32>) -> !fir.box<!fir.ptr<i32>>
! CHECK: fir.store %[[VAL_2]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
! CHECK: fir.call @_QPscalar_ptr(%[[VAL_1]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<i32>>>) -> ()
call scalar_ptr(p)
end subroutine
! CHECK-LABEL: func @_QMcall_defsPtest_non_ptr_to_array_ptr(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "p", fir.target}) {
subroutine test_non_ptr_to_array_ptr(p)
integer, target :: p(:)
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>>
! CHECK: %[[VAL_2:.*]] = fir.rebox %[[VAL_0]] : (!fir.box<!fir.array<?xi32>>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
! CHECK: fir.store %[[VAL_2]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
! CHECK: fir.call @_QParray_ptr(%[[VAL_1]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> ()
call array_ptr(p)
end subroutine
! CHECK-LABEL: func @_QMcall_defsPtest_non_ptr_to_array_ptr_lower_bounds(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "p", fir.target}) {
subroutine test_non_ptr_to_array_ptr_lower_bounds(p)
! Test that local lower bounds of the actual argument are applied.
integer, target :: p(42:)
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>>
! CHECK: %[[VAL_2:.*]] = arith.constant 42 : i64
! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (i64) -> index
! CHECK: %[[VAL_4:.*]] = fir.shift %[[VAL_3]] : (index) -> !fir.shift<1>
! CHECK: %[[VAL_5:.*]] = fir.rebox %[[VAL_0]](%[[VAL_4]]) : (!fir.box<!fir.array<?xi32>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
! CHECK: fir.store %[[VAL_5]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
! CHECK: fir.call @_QParray_ptr(%[[VAL_1]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> ()
call array_ptr(p)
end subroutine
! CHECK-LABEL: func @_QMcall_defsPtest_non_ptr_to_char_array_ptr(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1> {fir.bindc_name = "p", fir.target}) {
subroutine test_non_ptr_to_char_array_ptr(p)
character(10), target :: p(10)
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
! CHECK: %[[VAL_2:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_2]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<10x!fir.char<1,10>>>
! CHECK: %[[VAL_3:.*]] = arith.constant 10 : index
! CHECK: %[[VAL_5:.*]] = arith.constant 10 : index
! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<!fir.array<10x!fir.char<1,10>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>
! CHECK: %[[VAL_8:.*]] = fir.embox %[[VAL_7]](%[[VAL_6]]) typeparams %[[VAL_3]] : (!fir.ref<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
! CHECK: fir.store %[[VAL_8]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
! CHECK: fir.call @_QPchar_array_ptr(%[[VAL_1]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> ()
call char_array_ptr(p)
end subroutine
! CHECK-LABEL: func @_QMcall_defsPtest_non_ptr_to_non_deferred_char_array_ptr(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "p", fir.target}) {
subroutine test_non_ptr_to_non_deferred_char_array_ptr(p)
character(*), target :: p(:)
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>
! CHECK: %[[VAL_2:.*]] = fir.rebox %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>
! CHECK: fir.store %[[VAL_2]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>>
! CHECK: fir.call @_QPnon_deferred_char_array_ptr(%[[VAL_1]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>>) -> ()
call non_deferred_char_array_ptr(p)
end subroutine
! CHECK-LABEL: func @_QMcall_defsPtest_allocatable_to_array_ptr(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>> {fir.bindc_name = "p", fir.target}) {
subroutine test_allocatable_to_array_ptr(p)
integer, allocatable, target :: p(:)
call array_ptr(p)
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>>
! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index
! CHECK: %[[VAL_4:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_3]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>, index) -> (index, index, index)
! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
! CHECK: %[[VAL_6:.*]] = fir.shape_shift %[[VAL_4]]#0, %[[VAL_4]]#1 : (index, index) -> !fir.shapeshift<1>
! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_5]](%[[VAL_6]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shapeshift<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
! CHECK: fir.store %[[VAL_7]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
! CHECK: fir.call @_QParray_ptr(%[[VAL_1]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> ()
end subroutine
end module
|