flang/test/Lower/pointer-args-caller.f90

   1 ! Test calls with POINTER dummy arguments on the caller side.
   2 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
   3
   4 module call_defs
   5 interface
   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
  18 end interface
  19 contains
  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"}) {
  27 subroutine 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)
  31 end 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"}) {
  35 subroutine test_ptr_to_array_ptr(p)
  36   integer, pointer :: p(:)
  37   call array_ptr(p)
  38 end 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"}) {
  42 subroutine 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)
  46 end 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"}
  50 subroutine 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)
  56 end 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}) {
  64 subroutine 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)
  71 end 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}) {
  75 subroutine 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)
  82 end 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}) {
  86 subroutine 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)
  97 end 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}) {
 101 subroutine 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_3:.*]] = arith.constant 10 : index
 106 ! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_2]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<10x!fir.char<1,10>>>
 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)
 114 end 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}) {
 118 subroutine 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)
 125 end 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}) {
 129 subroutine 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>>>>) -> ()
 141 end subroutine
 142
 143 end module