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