flang/test/Lower/HLFIR/calls-optional.f90

   1 ! Test lowering of user calls involving passing an actual argument
   2 ! that is syntactically present, but may be absent at runtime (is
   3 ! an optional or a pointer/allocatable).
   4 !
   5 ! RUN: bbc -emit-fir -hlfir -polymorphic-type -o - %s | FileCheck %s
   6
   7 subroutine optional_copy_in_out(x)
   8   interface
   9     subroutine takes_optional_explicit(x)
  10       real, optional :: x(*)
  11     end subroutine
  12   end interface
  13   real, optional :: x(:)
  14   call  takes_optional_explicit(x)
  15 end subroutine
  16 ! CHECK-LABEL: func.func @_QPoptional_copy_in_out(
  17 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFoptional_copy_in_outEx"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
  18 ! CHECK:  %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xf32>>) -> i1
  19 ! CHECK:  %[[VAL_3:.*]]:4 = fir.if %[[VAL_2]] -> (!fir.ref<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>, i1, !fir.box<!fir.array<?xf32>>) {
  20 ! CHECK:    %[[VAL_4:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, i1)
  21 ! CHECK:    %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]]#0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
  22 ! CHECK:    fir.result %[[VAL_5]], %[[VAL_4]]#0, %[[VAL_4]]#1, %[[VAL_1]]#0 : !fir.ref<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>, i1, !fir.box<!fir.array<?xf32>>
  23 ! CHECK:  } else {
  24 ! CHECK:    %[[VAL_6:.*]] = fir.absent !fir.ref<!fir.array<?xf32>>
  25 ! CHECK:    %[[VAL_7:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
  26 ! CHECK:    %[[VAL_8:.*]] = arith.constant false
  27 ! CHECK:    %[[VAL_9:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
  28 ! CHECK:    fir.result %[[VAL_6]], %[[VAL_7]], %[[VAL_8]], %[[VAL_9]] : !fir.ref<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>, i1, !fir.box<!fir.array<?xf32>>
  29 ! CHECK:  }
  30 ! CHECK:  fir.call @_QPtakes_optional_explicit(%[[VAL_3]]#0) {{.*}} : (!fir.ref<!fir.array<?xf32>>) -> ()
  31 ! CHECK:  hlfir.copy_out %[[VAL_3]]#1, %[[VAL_3]]#2 to %[[VAL_3]]#3 : (!fir.box<!fir.array<?xf32>>, i1, !fir.box<!fir.array<?xf32>>) -> ()
  32
  33 subroutine optional_value_copy(x)
  34   interface
  35     subroutine takes_optional_explicit_value(x)
  36       real, value, optional :: x(100)
  37     end subroutine
  38   end interface
  39   real, optional :: x(100)
  40   call  takes_optional_explicit_value(x)
  41 end subroutine
  42 ! CHECK-LABEL: func.func @_QPoptional_value_copy(
  43 ! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_2:[a-z0-9]*]]) {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFoptional_value_copyEx"} : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>)
  44 ! CHECK:  %[[VAL_4:.*]] = fir.is_present %[[VAL_3]]#0 : (!fir.ref<!fir.array<100xf32>>) -> i1
  45 ! CHECK:  %[[VAL_5:.*]]:3 = fir.if %[[VAL_4]] -> (!fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>, i1) {
  46 ! CHECK:    %[[VAL_6:.*]] = hlfir.as_expr %[[VAL_3]]#0 : (!fir.ref<!fir.array<100xf32>>) -> !hlfir.expr<100xf32>
  47 ! CHECK:    %[[VAL_7:.*]]:3 = hlfir.associate %[[VAL_6]](%[[VAL_2]]) {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<100xf32>, !fir.shape<1>) -> (!fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>, i1)
  48 ! CHECK:    fir.result %[[VAL_7]]#1, %[[VAL_7]]#1, %[[VAL_7]]#2 : !fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>, i1
  49 ! CHECK:  } else {
  50 ! CHECK:    %[[VAL_8:.*]] = fir.absent !fir.ref<!fir.array<100xf32>>
  51 ! CHECK:    %[[VAL_9:.*]] = fir.absent !fir.ref<!fir.array<100xf32>>
  52 ! CHECK:    %[[VAL_10:.*]] = arith.constant false
  53 ! CHECK:    fir.result %[[VAL_8]], %[[VAL_9]], %[[VAL_10]] : !fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>, i1
  54 ! CHECK:  }
  55 ! CHECK:  fir.call @_QPtakes_optional_explicit_value(%[[VAL_5]]#0) {{.*}} : (!fir.ref<!fir.array<100xf32>>) -> ()
  56 ! CHECK:  hlfir.end_associate %[[VAL_5]]#1, %[[VAL_5]]#2 : !fir.ref<!fir.array<100xf32>>, i1
  57
  58 subroutine elem_pointer_to_optional(x, y)
  59   interface
  60     elemental subroutine elem_takes_two_optional(x, y)
  61       real, optional, intent(in) :: y, x
  62     end subroutine
  63   end interface
  64   real :: x(:)
  65   real, pointer :: y(:)
  66   call elem_takes_two_optional(x, y)
  67 end subroutine
  68 ! CHECK-LABEL: func.func @_QPelem_pointer_to_optional(
  69 ! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {uniq_name = "_QFelem_pointer_to_optionalEx"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
  70 ! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFelem_pointer_to_optionalEy"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>)
  71 ! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
  72 ! CHECK:  %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
  73 ! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
  74 ! CHECK:  %[[VAL_7:.*]] = arith.constant 0 : i64
  75 ! CHECK:  %[[VAL_8:.*]] = arith.cmpi ne, %[[VAL_6]], %[[VAL_7]] : i64
  76 ! CHECK:  %[[VAL_9:.*]] = arith.constant 0 : index
  77 ! CHECK:  %[[VAL_10:.*]]:3 = fir.box_dims %[[VAL_2]]#0, %[[VAL_9]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
  78 ! CHECK:  %[[VAL_11:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
  79 ! CHECK:  %[[VAL_12:.*]] = arith.constant 1 : index
  80 ! CHECK:  fir.do_loop %[[VAL_13:.*]] = %[[VAL_12]] to %[[VAL_10]]#1 step %[[VAL_12]] {
  81 ! CHECK:    %[[VAL_14:.*]] = hlfir.designate %[[VAL_2]]#0 (%[[VAL_13]])  : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>
  82 ! CHECK:    %[[VAL_15:.*]] = fir.if %[[VAL_8]] -> (!fir.ref<f32>) {
  83 ! CHECK:      %[[VAL_16:.*]] = arith.constant 0 : index
  84 ! CHECK:      %[[VAL_17:.*]]:3 = fir.box_dims %[[VAL_11]], %[[VAL_16]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
  85 ! CHECK:      %[[VAL_18:.*]] = arith.constant 1 : index
  86 ! CHECK:      %[[VAL_19:.*]] = arith.subi %[[VAL_17]]#0, %[[VAL_18]] : index
  87 ! CHECK:      %[[VAL_20:.*]] = arith.addi %[[VAL_13]], %[[VAL_19]] : index
  88 ! CHECK:      %[[VAL_21:.*]] = hlfir.designate %[[VAL_11]] (%[[VAL_20]])  : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> !fir.ref<f32>
  89 ! CHECK:      fir.result %[[VAL_21]] : !fir.ref<f32>
  90 ! CHECK:    } else {
  91 ! CHECK:      %[[VAL_22:.*]] = fir.absent !fir.ref<f32>
  92 ! CHECK:      fir.result %[[VAL_22]] : !fir.ref<f32>
  93 ! CHECK:    }
  94 ! CHECK:    fir.call @_QPelem_takes_two_optional(%[[VAL_14]], %[[VAL_15]]) {{.*}} : (!fir.ref<f32>, !fir.ref<f32>) -> ()
  95 ! CHECK:  }
  96
  97 subroutine optional_cannot_be_absent_optional(x)
  98   interface
  99     elemental subroutine elem_takes_one_optional(x)
 100       real, optional, intent(in) :: x
 101     end subroutine
 102   end interface
 103   real, optional :: x(:)
 104   ! If all array arguments in an call are optional, they must be all present.
 105   call elem_takes_one_optional(x)
 106 end subroutine
 107 ! CHECK-LABEL: func.func @_QPoptional_cannot_be_absent_optional(
 108 ! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFoptional_cannot_be_absent_optionalEx"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
 109 ! CHECK:  %[[VAL_2:.*]] = arith.constant 0 : index
 110 ! CHECK:  %[[VAL_3:.*]]:3 = fir.box_dims %[[VAL_1]]#0, %[[VAL_2]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
 111 ! CHECK:  %[[VAL_4:.*]] = arith.constant 1 : index
 112 ! CHECK:  fir.do_loop %[[VAL_5:.*]] = %[[VAL_4]] to %[[VAL_3]]#1 step %[[VAL_4]] {
 113 ! CHECK:    %[[VAL_6:.*]] = hlfir.designate %[[VAL_1]]#0 (%[[VAL_5]])  : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>
 114 ! CHECK:    fir.call @_QPelem_takes_one_optional(%[[VAL_6]]) {{.*}} : (!fir.ref<f32>) -> ()
 115 ! CHECK:  }
 116
 117 subroutine optional_elem_poly(x, y)
 118   interface
 119     elemental subroutine elem_optional_poly(x, y)
 120       class(*), optional, intent(in) :: x, y
 121     end subroutine
 122   end interface
 123   real :: x(:)
 124   real, optional :: y(:)
 125   call elem_optional_poly(x, y)
 126 end subroutine
 127 ! CHECK-LABEL: func.func @_QPoptional_elem_poly(
 128 ! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {uniq_name = "_QFoptional_elem_polyEx"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
 129 ! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFoptional_elem_polyEy"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
 130 ! CHECK:  %[[VAL_4:.*]] = fir.is_present %[[VAL_3]]#0 : (!fir.box<!fir.array<?xf32>>) -> i1
 131 ! CHECK:  %[[VAL_5:.*]] = arith.constant 0 : index
 132 ! CHECK:  %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_2]]#0, %[[VAL_5]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
 133 ! CHECK:  %[[VAL_7:.*]] = arith.constant 1 : index
 134 ! CHECK:  fir.do_loop %[[VAL_8:.*]] = %[[VAL_7]] to %[[VAL_6]]#1 step %[[VAL_7]] {
 135 ! CHECK:    %[[VAL_9:.*]] = hlfir.designate %[[VAL_2]]#0 (%[[VAL_8]])  : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>
 136 ! CHECK:    %[[VAL_10:.*]] = fir.embox %[[VAL_9]] : (!fir.ref<f32>) -> !fir.box<f32>
 137 ! CHECK:    %[[VAL_11:.*]] = fir.rebox %[[VAL_10]] : (!fir.box<f32>) -> !fir.class<none>
 138 ! CHECK:    %[[VAL_12:.*]] = fir.if %[[VAL_4]] -> (!fir.class<none>) {
 139 ! CHECK:      %[[VAL_13:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_8]])  : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>
 140 ! CHECK:      %[[VAL_14:.*]] = fir.embox %[[VAL_13]] : (!fir.ref<f32>) -> !fir.box<f32>
 141 ! CHECK:      %[[VAL_15:.*]] = fir.rebox %[[VAL_14]] : (!fir.box<f32>) -> !fir.class<none>
 142 ! CHECK:      fir.result %[[VAL_15]] : !fir.class<none>
 143 ! CHECK:    } else {
 144 ! CHECK:      %[[VAL_16:.*]] = fir.absent !fir.class<none>
 145 ! CHECK:      fir.result %[[VAL_16]] : !fir.class<none>
 146 ! CHECK:    }
 147 ! CHECK:    fir.call @_QPelem_optional_poly(%[[VAL_11]], %[[VAL_12]]) {{.*}} : (!fir.class<none>, !fir.class<none>) -> ()
 148 ! CHECK:  }
 149
 150 subroutine test_passing_null()
 151   interface
 152     subroutine takes_optional_assumed(x)
 153       real, optional :: x(:)
 154     end subroutine
 155   end interface
 156   call takes_optional_assumed(null())
 157  ! NULL(MOLD) lowering is a TODO in HLFIR.
 158  ! call takes_optional_assumed(null(p))
 159 end subroutine
 160 ! CHECK-LABEL: func.func @_QPtest_passing_null() {
 161 ! CHECK:  %[[VAL_0:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
 162 ! CHECK:  fir.call @_QPtakes_optional_assumed(%[[VAL_0]]) {{.*}} : (!fir.box<!fir.array<?xf32>>) -> ()