flang/test/Lower/dummy-argument-optional.f90

   1 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
   2 ! RUN: flang-new -fc1 -fdefault-integer-8 -emit-fir %s -o - | FileCheck %s
   3
   4 ! Test OPTIONAL lowering on caller/callee and PRESENT intrinsic.
   5 module opt
   6   implicit none
   7   type t
   8     real, allocatable :: p(:)
   9   end type
  10 contains
  11
  12 ! Test simple scalar optional
  13 ! CHECK-LABEL: func @_QMoptPintrinsic_scalar(
  14 ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<f32> {fir.bindc_name = "x", fir.optional}) {
  15 subroutine intrinsic_scalar(x)
  16   real, optional :: x
  17   ! CHECK: fir.is_present %[[arg0]] : (!fir.ref<f32>) -> i1
  18   print *, present(x)
  19 end subroutine
  20 ! CHECK-LABEL: @_QMoptPcall_intrinsic_scalar()
  21 subroutine call_intrinsic_scalar()
  22   ! CHECK: %[[x:.*]] = fir.alloca f32
  23   real :: x
  24   ! CHECK: fir.call @_QMoptPintrinsic_scalar(%[[x]]) {{.*}}: (!fir.ref<f32>) -> ()
  25   call intrinsic_scalar(x)
  26   ! CHECK: %[[absent:.*]] = fir.absent !fir.ref<f32>
  27   ! CHECK: fir.call @_QMoptPintrinsic_scalar(%[[absent]]) {{.*}}: (!fir.ref<f32>) -> ()
  28   call intrinsic_scalar()
  29 end subroutine
  30
  31 ! Test explicit shape array optional
  32 ! CHECK-LABEL: func @_QMoptPintrinsic_f77_array(
  33 ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.array<100xf32>> {fir.bindc_name = "x", fir.optional}) {
  34 subroutine intrinsic_f77_array(x)
  35   real, optional :: x(100)
  36   ! CHECK: fir.is_present %[[arg0]] : (!fir.ref<!fir.array<100xf32>>) -> i1
  37   print *, present(x)
  38 end subroutine
  39 ! CHECK-LABEL: func @_QMoptPcall_intrinsic_f77_array()
  40 subroutine call_intrinsic_f77_array()
  41   ! CHECK: %[[x:.*]] = fir.alloca !fir.array<100xf32>
  42   real :: x(100)
  43   ! CHECK: fir.call @_QMoptPintrinsic_f77_array(%[[x]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
  44   call intrinsic_f77_array(x)
  45   ! CHECK: %[[absent:.*]] = fir.absent !fir.ref<!fir.array<100xf32>>
  46   ! CHECK: fir.call @_QMoptPintrinsic_f77_array(%[[absent]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
  47   call intrinsic_f77_array()
  48 end subroutine
  49
  50 ! Test optional character scalar
  51 ! CHECK-LABEL: func @_QMoptPcharacter_scalar(
  52 ! CHECK-SAME: %[[arg0:.*]]: !fir.boxchar<1> {fir.bindc_name = "x", fir.optional}) {
  53 subroutine character_scalar(x)
  54   ! CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %[[arg0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
  55   ! CHECK: %[[ref:.*]] = fir.convert %[[unboxed]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,10>>
  56   character(10), optional :: x
  57   ! CHECK: fir.is_present %[[ref]] : (!fir.ref<!fir.char<1,10>>) -> i1
  58   print *, present(x)
  59 end subroutine
  60 ! CHECK-LABEL: func @_QMoptPcall_character_scalar()
  61 subroutine call_character_scalar()
  62   ! CHECK: %[[addr:.*]] = fir.alloca !fir.char<1,10>
  63   character(10) :: x
  64   ! CHECK: %[[addrCast:.*]] = fir.convert %[[addr]]
  65   ! CHECK: %[[x:.*]] = fir.emboxchar %[[addrCast]], {{.*}}
  66   ! CHECK: fir.call @_QMoptPcharacter_scalar(%[[x]]) {{.*}}: (!fir.boxchar<1>) -> ()
  67   call character_scalar(x)
  68   ! CHECK: %[[absent:.*]] = fir.absent !fir.boxchar<1>
  69   ! CHECK: fir.call @_QMoptPcharacter_scalar(%[[absent]]) {{.*}}: (!fir.boxchar<1>) -> ()
  70   call character_scalar()
  71 end subroutine
  72
  73 ! Test optional character function
  74 ! CHECK-LABEL: func @_QMoptPchar_proc(
  75 ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.char<1,3>>,
  76 character(len=3) function char_proc(i)
  77   integer :: i
  78   char_proc = "XYZ"
  79 end function
  80 ! CHECK-LABEL: func @_QMoptPuse_char_proc(
  81 ! CHECK-SAME: %[[arg0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc},
  82 subroutine use_char_proc(f, c)
  83   optional :: f
  84   interface
  85     character(len=3) function f(i)
  86       integer :: i
  87     end function
  88   end interface
  89   character(len=3) :: c
  90 ! CHECK: %[[boxProc:.*]] = fir.extract_value %[[arg0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
  91 ! CHECK: %[[procAddr:.*]] = fir.box_addr %[[boxProc]] : (!fir.boxproc<() -> ()>) -> (() -> ())
  92 ! CHECK: %{{.*}} = fir.is_present %[[procAddr]] : (() -> ()) -> i1
  93   if (present(f)) then
  94     c = f(0)
  95   else
  96     c = "ABC"
  97   end if
  98 end subroutine
  99 ! CHECK-LABEL: func @_QMoptPcall_use_char_proc(
 100 subroutine call_use_char_proc()
 101   character(len=3) :: c
 102 ! CHECK: %[[boxProc:.*]] = fir.absent !fir.boxproc<() -> ()>
 103 ! CHECK: %[[undef:.*]] = fir.undefined index
 104 ! CHECK: %[[charLen:.*]] = fir.convert %[[undef]] : (index) -> i64
 105 ! CHECK: %[[tuple:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
 106 ! CHECK: %[[tuple2:.*]] = fir.insert_value %[[tuple]], %[[boxProc]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
 107 ! CHECK: %[[tuple3:.*]] = fir.insert_value %[[tuple2]], %[[charLen]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
 108 ! CHECK: fir.call @_QMoptPuse_char_proc(%[[tuple3]], %{{.*}}){{.*}} : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxchar<1>) -> ()
 109   call use_char_proc(c=c)
 110 ! CHECK: %[[funcAddr:.*]] = fir.address_of(@_QMoptPchar_proc) : (!fir.ref<!fir.char<1,3>>, index, {{.*}}) -> !fir.boxchar<1>
 111 ! CHECK: %[[c3:.*]] = arith.constant 3 : i64
 112 ! CHECK: %[[boxProc2:.*]] = fir.emboxproc %[[funcAddr]] : ((!fir.ref<!fir.char<1,3>>, index, {{.*}}) -> !fir.boxchar<1>) -> !fir.boxproc<() -> ()>
 113 ! CHECK: %[[tuple4:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
 114 ! CHECK: %[[tuple5:.*]] = fir.insert_value %[[tuple4]], %[[boxProc2]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
 115 ! CHECK: %[[tuple6:.*]] = fir.insert_value %[[tuple5]], %[[c3]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
 116 ! CHECK: fir.call @_QMoptPuse_char_proc(%[[tuple6]], {{.*}}){{.*}} : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxchar<1>) -> ()
 117   call use_char_proc(char_proc, c)
 118 end subroutine
 119
 120 ! Test optional assumed shape
 121 ! CHECK-LABEL: func @_QMoptPassumed_shape(
 122 ! CHECK-SAME: %[[arg0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
 123 subroutine assumed_shape(x)
 124   real, optional :: x(:)
 125   ! CHECK: fir.is_present %[[arg0]] : (!fir.box<!fir.array<?xf32>>) -> i1
 126   print *, present(x)
 127 end subroutine
 128 ! CHECK: func @_QMoptPcall_assumed_shape()
 129 subroutine call_assumed_shape()
 130   ! CHECK: %[[addr:.*]] = fir.alloca !fir.array<100xf32>
 131   real :: x(100)
 132   ! CHECK: %[[embox:.*]] = fir.embox %[[addr]]
 133   ! CHECK: %[[x:.*]] = fir.convert %[[embox]] : (!fir.box<!fir.array<100xf32>>) -> !fir.box<!fir.array<?xf32>>
 134   ! CHECK: fir.call @_QMoptPassumed_shape(%[[x]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
 135   call assumed_shape(x)
 136   ! CHECK: %[[absent:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
 137   ! CHECK: fir.call @_QMoptPassumed_shape(%[[absent]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
 138   call assumed_shape()
 139 end subroutine
 140
 141 ! Test optional allocatable
 142 ! CHECK: func @_QMoptPallocatable_array(
 143 ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> {fir.bindc_name = "x", fir.optional}) {
 144 subroutine allocatable_array(x)
 145   real, allocatable, optional :: x(:)
 146   ! CHECK: fir.is_present %[[arg0]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> i1
 147   print *, present(x)
 148 end subroutine
 149 ! CHECK: func @_QMoptPcall_allocatable_array()
 150 subroutine call_allocatable_array()
 151   ! CHECK: %[[x:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>>
 152   real, allocatable :: x(:)
 153   ! CHECK: fir.call @_QMoptPallocatable_array(%[[x]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
 154   call allocatable_array(x)
 155   ! CHECK: %[[absent:.*]] = fir.absent !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
 156   ! CHECK: fir.call @_QMoptPallocatable_array(%[[absent]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
 157   call allocatable_array()
 158 end subroutine
 159
 160 ! CHECK: func @_QMoptPallocatable_to_assumed_optional_array(
 161 ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>{{.*}}) {
 162 subroutine allocatable_to_assumed_optional_array(x)
 163   real, allocatable :: x(:)
 164
 165   ! CHECK: %[[xboxload:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
 166   ! CHECK: %[[xptr:.*]] = fir.box_addr %[[xboxload]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
 167   ! CHECK: %[[xaddr:.*]] = fir.convert %[[xptr]] : (!fir.heap<!fir.array<?xf32>>) -> i64
 168   ! CHECK: %[[isAlloc:.*]] = arith.cmpi ne, %[[xaddr]], %c0{{.*}} : i64
 169   ! CHECK: %[[absent:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
 170   ! CHECK: %[[embox:.*]] = fir.embox %{{.*}}
 171   ! CHECK: %[[actual:.*]] = arith.select %[[isAlloc]], %[[embox]], %[[absent]] : !fir.box<!fir.array<?xf32>>
 172   ! CHECK: fir.call @_QMoptPassumed_shape(%[[actual]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
 173   call assumed_shape(x)
 174 end subroutine
 175
 176 ! CHECK-LABEL: func @_QMoptPalloc_component_to_optional_assumed_shape(
 177 subroutine alloc_component_to_optional_assumed_shape(x)
 178   type(t) :: x(100)
 179   ! CHECK-DAG: %[[isAlloc:.*]] = arith.cmpi ne
 180   ! CHECK-DAG: %[[absent:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
 181   ! CHECK: %[[select:.*]] = arith.select %[[isAlloc]], %{{.*}}, %[[absent]] : !fir.box<!fir.array<?xf32>>
 182   ! CHECK: fir.call @_QMoptPassumed_shape(%[[select]])
 183   call assumed_shape(x(55)%p)
 184 end subroutine
 185
 186 ! CHECK-LABEL: func @_QMoptPalloc_component_eval_only_once(
 187 subroutine alloc_component_eval_only_once(x)
 188   integer, external :: ifoo
 189   type(t) :: x(100)
 190   ! Verify that the index in the component reference are not evaluated twice
 191   ! because if the optional handling logic.
 192   ! CHECK: fir.call @_QPifoo()
 193   ! CHECK-NOT: fir.call @_QPifoo()
 194   call assumed_shape(x(ifoo())%p)
 195 end subroutine
 196
 197 ! CHECK-LABEL: func @_QMoptPnull_as_optional() {
 198 subroutine null_as_optional
 199   ! CHECK: %[[null_ptr:.*]] = fir.alloca !fir.box<!fir.ptr<none>>
 200   ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<none>
 201   ! CHECK: %[[null_box:.*]] = fir.embox %[[null]] : (!fir.ptr<none>) -> !fir.box<!fir.ptr<none>>
 202   ! CHECK: fir.store %[[null_box]] to %[[null_ptr]] : !fir.ref<!fir.box<!fir.ptr<none>>>
 203   ! CHECK: fir.call @_QMoptPassumed_shape(%{{.*}}) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
 204  call assumed_shape(null())
 205 end subroutine null_as_optional
 206
 207 end module