flang/test/Lower/HLFIR/allocatables-and-pointers.f90

   1 ! Test lowering of whole allocatable and pointers to HLFIR
   2 ! RUN: bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s
   3
   4 subroutine passing_allocatable(x)
   5   interface
   6     subroutine takes_allocatable(y)
   7       real, allocatable :: y(:)
   8     end subroutine
   9     subroutine takes_array(y)
  10       real :: y(*)
  11     end subroutine
  12   end interface
  13   real, allocatable :: x(:)
  14   call takes_allocatable(x)
  15   call takes_array(x)
  16 end subroutine
  17 ! CHECK-LABEL: func.func @_QPpassing_allocatable(
  18 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name =  {{.*}}Ex"}
  19 ! CHECK:  fir.call @_QPtakes_allocatable(%[[VAL_1]]#0) {{.*}} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
  20 ! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
  21 ! CHECK:  %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
  22 ! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
  23 ! CHECK:  fir.call @_QPtakes_array(%[[VAL_4]]) {{.*}} : (!fir.ref<!fir.array<?xf32>>) -> ()
  24
  25 subroutine passing_pointer(x)
  26   interface
  27     subroutine takes_pointer(y)
  28       real, pointer :: y(:)
  29     end subroutine
  30   end interface
  31   real, pointer :: x(:)
  32   call takes_pointer(x)
  33   call takes_pointer(NULL())
  34 end subroutine
  35 ! CHECK-LABEL: func.func @_QPpassing_pointer(
  36 ! CHECK:  %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>>
  37 ! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name =  {{.*}}Ex"}
  38 ! CHECK:  fir.call @_QPtakes_pointer(%[[VAL_2]]#0) {{.*}} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> ()
  39 ! CHECK:  %[[VAL_3:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
  40 ! CHECK:  %[[VAL_4:.*]] = arith.constant 0 : index
  41 ! CHECK:  %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1>
  42 ! CHECK:  %[[VAL_6:.*]] = fir.embox %[[VAL_3]](%[[VAL_5]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
  43 ! CHECK:  fir.store %[[VAL_6]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
  44 ! CHECK:  fir.call @_QPtakes_pointer(%[[VAL_1]]) {{.*}} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> ()
  45
  46 subroutine passing_contiguous_pointer(x)
  47   interface
  48     subroutine takes_array(y)
  49       real :: y(*)
  50     end subroutine
  51   end interface
  52   real, pointer, contiguous :: x(:)
  53   call takes_array(x)
  54 end subroutine
  55 ! CHECK-LABEL: func.func @_QPpassing_contiguous_pointer(
  56 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<contiguous, pointer>, uniq_name =  {{.*}}Ex"}
  57 ! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
  58 ! CHECK:  %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
  59 ! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
  60 ! CHECK:  fir.call @_QPtakes_array(%[[VAL_4]]) {{.*}} : (!fir.ref<!fir.array<?xf32>>) -> ()
  61
  62 subroutine character_allocatable_cst_len(x)
  63   character(10), allocatable :: x
  64   call takes_char(x)
  65   call takes_char(x//"hello")
  66 end subroutine
  67 ! CHECK-LABEL: func.func @_QPcharacter_allocatable_cst_len(
  68 ! CHECK:  %[[VAL_1:.*]] = arith.constant 10 : index
  69 ! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] typeparams %[[VAL_1:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name =  {{.*}}Ex"}
  70 ! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>
  71 ! CHECK:  %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.heap<!fir.char<1,10>>>) -> !fir.heap<!fir.char<1,10>>
  72 ! CHECK:  %[[VAL_5:.*]] = arith.constant 10 : index
  73 ! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_4]] : (!fir.heap<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,10>>
  74 ! CHECK:  %[[VAL_7:.*]] = fir.emboxchar %[[VAL_6]], %[[VAL_5]] : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>
  75 ! CHECK:  fir.call @_QPtakes_char(%[[VAL_7]]) {{.*}} : (!fir.boxchar<1>) -> ()
  76 ! CHECK:  %[[VAL_8:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>
  77 ! CHECK:  %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box<!fir.heap<!fir.char<1,10>>>) -> !fir.heap<!fir.char<1,10>>
  78 ! CHECK:  %[[VAL_12:.*]]:2 = hlfir.declare %[[VAL_10:[a-z0-9]*]] typeparams %[[VAL_11:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<parameter>
  79 ! CHECK:  %[[VAL_13:.*]] = arith.constant 10 : index
  80 ! CHECK:  %[[VAL_14:.*]] = arith.addi %[[VAL_13]], %[[VAL_11]] : index
  81 ! CHECK:  %[[VAL_15:.*]] = hlfir.concat %[[VAL_9]], %[[VAL_12]]#0 len %[[VAL_14]] : (!fir.heap<!fir.char<1,10>>, !fir.ref<!fir.char<1,5>>, index) -> !hlfir.expr<!fir.char<1,15>>
  82
  83 subroutine character_allocatable_dyn_len(x, l)
  84   integer(8) :: l
  85   character(l), allocatable :: x
  86   call takes_char(x)
  87   call takes_char(x//"hello")
  88 end subroutine
  89 ! CHECK-LABEL: func.func @_QPcharacter_allocatable_dyn_len(
  90 ! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {uniq_name =  {{.*}}El"}
  91 ! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<i64>
  92 ! CHECK:  %[[VAL_4:.*]] = arith.constant 0 : i64
  93 ! CHECK:  %[[VAL_5:.*]] = arith.cmpi sgt, %[[VAL_3]], %[[VAL_4]] : i64
  94 ! CHECK:  %[[VAL_6:.*]] = arith.select %[[VAL_5]], %[[VAL_3]], %[[VAL_4]] : i64
  95 ! CHECK:  %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] typeparams %[[VAL_6:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name =  {{.*}}Ex"}
  96 ! CHECK:  %[[VAL_8:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
  97 ! CHECK:  %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
  98 ! CHECK:  %[[VAL_10:.*]] = fir.emboxchar %[[VAL_9]], %[[VAL_6]] : (!fir.heap<!fir.char<1,?>>, i64) -> !fir.boxchar<1>
  99 ! CHECK:  fir.call @_QPtakes_char(%[[VAL_10]]) {{.*}} : (!fir.boxchar<1>) -> ()
 100 ! CHECK:  %[[VAL_11:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
 101 ! CHECK:  %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
 102 ! CHECK:  %[[VAL_13:.*]] = fir.emboxchar %[[VAL_12]], %[[VAL_6]] : (!fir.heap<!fir.char<1,?>>, i64) -> !fir.boxchar<1>
 103 ! CHECK:  %[[VAL_16:.*]]:2 = hlfir.declare %[[VAL_14:[a-z0-9]*]] typeparams %[[VAL_15:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<parameter>
 104 ! CHECK:  %[[VAL_17:.*]] = fir.convert %[[VAL_6]] : (i64) -> index
 105 ! CHECK:  %[[VAL_18:.*]] = arith.addi %[[VAL_17]], %[[VAL_15]] : index
 106 ! CHECK:  %[[VAL_19:.*]] = hlfir.concat %[[VAL_13]], %[[VAL_16]]#0 len %[[VAL_18]] : (!fir.boxchar<1>, !fir.ref<!fir.char<1,5>>, index) -> !hlfir.expr<!fir.char<1,?>>
 107
 108 subroutine print_allocatable(x)
 109   real, allocatable :: x(:)
 110   print *, x
 111 end subroutine
 112 ! CHECK-LABEL: func.func @_QPprint_allocatable(
 113 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name =  {{.*}}Ex"}
 114 ! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_1]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
 115 ! CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.box<none>
 116 ! CHECK:  %[[VAL_9:.*]] = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[VAL_8]])
 117
 118 subroutine print_pointer(x)
 119   real, pointer :: x(:)
 120   print *, x
 121 end subroutine
 122 ! CHECK-LABEL: func.func @_QPprint_pointer(
 123 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name =  {{.*}}Ex"}
 124 ! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_1]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
 125 ! CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
 126 ! CHECK:  %[[VAL_9:.*]] = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[VAL_8]])
 127
 128 subroutine elemental_expr(x)
 129   integer, pointer :: x(:, :)
 130   call takes_array_2(x+42)
 131 end subroutine
 132 ! CHECK-LABEL: func.func @_QPelemental_expr(
 133 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name =  {{.*}}Ex"}
 134 ! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xi32>>>>
 135 ! CHECK:  %[[VAL_3:.*]] = arith.constant 42 : i32
 136 ! CHECK:  %[[VAL_4:.*]] = arith.constant 0 : index
 137 ! CHECK:  %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
 138 ! CHECK:  %[[VAL_6:.*]] = arith.constant 1 : index
 139 ! CHECK:  %[[VAL_7:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
 140 ! CHECK:  %[[VAL_8:.*]] = fir.shape %[[VAL_5]]#1, %[[VAL_7]]#1 : (index, index) -> !fir.shape<2>
 141 ! CHECK:  %[[VAL_9:.*]] = hlfir.elemental %[[VAL_8]] : (!fir.shape<2>) -> !hlfir.expr<?x?xi32> {
 142 ! CHECK:  ^bb0(%[[VAL_10:.*]]: index, %[[VAL_11:.*]]: index):
 143 ! CHECK:    %[[VAL_12:.*]] = arith.constant 0 : index
 144 ! CHECK:    %[[VAL_13:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_12]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
 145 ! CHECK:    %[[VAL_14:.*]] = arith.constant 1 : index
 146 ! CHECK:    %[[VAL_15:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_14]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
 147 ! CHECK:    %[[VAL_16:.*]] = arith.constant 1 : index
 148 ! CHECK:    %[[VAL_17:.*]] = arith.subi %[[VAL_13]]#0, %[[VAL_16]] : index
 149 ! CHECK:    %[[VAL_18:.*]] = arith.addi %[[VAL_10]], %[[VAL_17]] : index
 150 ! CHECK:    %[[VAL_19:.*]] = arith.subi %[[VAL_15]]#0, %[[VAL_16]] : index
 151 ! CHECK:    %[[VAL_20:.*]] = arith.addi %[[VAL_11]], %[[VAL_19]] : index
 152 ! CHECK:    %[[VAL_21:.*]] = hlfir.designate %[[VAL_2]] (%[[VAL_18]], %[[VAL_20]])  : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index, index) -> !fir.ref<i32>
 153 ! CHECK:    %[[VAL_22:.*]] = fir.load %[[VAL_21]] : !fir.ref<i32>
 154 ! CHECK:    %[[VAL_23:.*]] = arith.addi %[[VAL_22]], %[[VAL_3]] : i32
 155 ! CHECK:    hlfir.yield_element %[[VAL_23]] : i32
 156 ! CHECK:  }