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

   1 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
   2
   3 ! Test OPTIONAL lowering on caller/callee and PRESENT intrinsic.
   4 module opt
   5   implicit none
   6   type t
   7     real, allocatable :: p(:)
   8   end type
   9 contains
  10
  11 ! Test simple scalar optional
  12 ! CHECK-LABEL: func @_QMoptPintrinsic_scalar(
  13 ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<f32> {fir.bindc_name = "x", fir.optional}) {
  14 subroutine intrinsic_scalar(x)
  15   real, optional :: x
  16   ! CHECK: fir.is_present %[[arg0]] : (!fir.ref<f32>) -> i1
  17   print *, present(x)
  18 end subroutine
  19 ! CHECK-LABEL: @_QMoptPcall_intrinsic_scalar()
  20 subroutine call_intrinsic_scalar()
  21   ! CHECK: %[[x:.*]] = fir.alloca f32
  22   real :: x
  23   ! CHECK: fir.call @_QMoptPintrinsic_scalar(%[[x]]) {{.*}}: (!fir.ref<f32>) -> ()
  24   call intrinsic_scalar(x)
  25   ! CHECK: %[[absent:.*]] = fir.absent !fir.ref<f32>
  26   ! CHECK: fir.call @_QMoptPintrinsic_scalar(%[[absent]]) {{.*}}: (!fir.ref<f32>) -> ()
  27   call intrinsic_scalar()
  28 end subroutine
  29
  30 ! Test explicit shape array optional
  31 ! CHECK-LABEL: func @_QMoptPintrinsic_f77_array(
  32 ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.array<100xf32>> {fir.bindc_name = "x", fir.optional}) {
  33 subroutine intrinsic_f77_array(x)
  34   real, optional :: x(100)
  35   ! CHECK: fir.is_present %[[arg0]] : (!fir.ref<!fir.array<100xf32>>) -> i1
  36   print *, present(x)
  37 end subroutine
  38 ! CHECK-LABEL: func @_QMoptPcall_intrinsic_f77_array()
  39 subroutine call_intrinsic_f77_array()
  40   ! CHECK: %[[x:.*]] = fir.alloca !fir.array<100xf32>
  41   real :: x(100)
  42   ! CHECK: fir.call @_QMoptPintrinsic_f77_array(%[[x]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
  43   call intrinsic_f77_array(x)
  44   ! CHECK: %[[absent:.*]] = fir.absent !fir.ref<!fir.array<100xf32>>
  45   ! CHECK: fir.call @_QMoptPintrinsic_f77_array(%[[absent]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
  46   call intrinsic_f77_array()
  47 end subroutine
  48
  49 ! Test optional character scalar
  50 ! CHECK-LABEL: func @_QMoptPcharacter_scalar(
  51 ! CHECK-SAME: %[[arg0:.*]]: !fir.boxchar<1> {fir.bindc_name = "x", fir.optional}) {
  52 subroutine character_scalar(x)
  53   ! CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %[[arg0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
  54   character(10), optional :: x
  55   ! CHECK: fir.is_present %[[unboxed]]#0 : (!fir.ref<!fir.char<1,?>>) -> i1
  56   print *, present(x)
  57 end subroutine
  58 ! CHECK-LABEL: func @_QMoptPcall_character_scalar()
  59 subroutine call_character_scalar()
  60   ! CHECK: %[[addr:.*]] = fir.alloca !fir.char<1,10>
  61   character(10) :: x
  62   ! CHECK: %[[addrCast:.*]] = fir.convert %[[addr]]
  63   ! CHECK: %[[x:.*]] = fir.emboxchar %[[addrCast]], {{.*}}
  64   ! CHECK: fir.call @_QMoptPcharacter_scalar(%[[x]]) {{.*}}: (!fir.boxchar<1>) -> ()
  65   call character_scalar(x)
  66   ! CHECK: %[[absent:.*]] = fir.absent !fir.boxchar<1>
  67   ! CHECK: fir.call @_QMoptPcharacter_scalar(%[[absent]]) {{.*}}: (!fir.boxchar<1>) -> ()
  68   call character_scalar()
  69 end subroutine
  70
  71 ! Test optional assumed shape
  72 ! CHECK-LABEL: func @_QMoptPassumed_shape(
  73 ! CHECK-SAME: %[[arg0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
  74 subroutine assumed_shape(x)
  75   real, optional :: x(:)
  76   ! CHECK: fir.is_present %[[arg0]] : (!fir.box<!fir.array<?xf32>>) -> i1
  77   print *, present(x)
  78 end subroutine
  79 ! CHECK: func @_QMoptPcall_assumed_shape()
  80 subroutine call_assumed_shape()
  81   ! CHECK: %[[addr:.*]] = fir.alloca !fir.array<100xf32>
  82   real :: x(100)
  83   ! CHECK: %[[embox:.*]] = fir.embox %[[addr]]
  84   ! CHECK: %[[x:.*]] = fir.convert %[[embox]] : (!fir.box<!fir.array<100xf32>>) -> !fir.box<!fir.array<?xf32>>
  85   ! CHECK: fir.call @_QMoptPassumed_shape(%[[x]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
  86   call assumed_shape(x)
  87   ! CHECK: %[[absent:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
  88   ! CHECK: fir.call @_QMoptPassumed_shape(%[[absent]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
  89   call assumed_shape()
  90 end subroutine
  91
  92 ! Test optional allocatable
  93 ! CHECK: func @_QMoptPallocatable_array(
  94 ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> {fir.bindc_name = "x", fir.optional}) {
  95 subroutine allocatable_array(x)
  96   real, allocatable, optional :: x(:)
  97   ! CHECK: fir.is_present %[[arg0]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> i1
  98   print *, present(x)
  99 end subroutine
 100 ! CHECK: func @_QMoptPcall_allocatable_array()
 101 subroutine call_allocatable_array()
 102   ! CHECK: %[[x:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>>
 103   real, allocatable :: x(:)
 104   ! CHECK: fir.call @_QMoptPallocatable_array(%[[x]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
 105   call allocatable_array(x)
 106   ! CHECK: %[[absent:.*]] = fir.absent !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
 107   ! CHECK: fir.call @_QMoptPallocatable_array(%[[absent]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
 108   call allocatable_array()
 109 end subroutine
 110
 111 ! CHECK: func @_QMoptPallocatable_to_assumed_optional_array(
 112 ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>{{.*}}) {
 113 subroutine allocatable_to_assumed_optional_array(x)
 114   real, allocatable :: x(:)
 115
 116   ! CHECK: %[[xboxload:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
 117   ! CHECK: %[[xptr:.*]] = fir.box_addr %[[xboxload]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
 118   ! CHECK: %[[xaddr:.*]] = fir.convert %[[xptr]] : (!fir.heap<!fir.array<?xf32>>) -> i64
 119   ! CHECK: %[[isAlloc:.*]] = arith.cmpi ne, %[[xaddr]], %c0{{.*}} : i64
 120   ! CHECK: %[[absent:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
 121   ! CHECK: %[[embox:.*]] = fir.embox %{{.*}}
 122   ! CHECK: %[[actual:.*]] = arith.select %[[isAlloc]], %[[embox]], %[[absent]] : !fir.box<!fir.array<?xf32>>
 123   ! CHECK: fir.call @_QMoptPassumed_shape(%[[actual]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
 124   call assumed_shape(x)
 125 end subroutine
 126
 127 ! CHECK-LABEL: func @_QMoptPalloc_component_to_optional_assumed_shape(
 128 subroutine alloc_component_to_optional_assumed_shape(x)
 129   type(t) :: x(100)
 130   ! CHECK-DAG: %[[isAlloc:.*]] = arith.cmpi ne
 131   ! CHECK-DAG: %[[absent:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
 132   ! CHECK: %[[select:.*]] = arith.select %[[isAlloc]], %{{.*}}, %[[absent]] : !fir.box<!fir.array<?xf32>>
 133   ! CHECK: fir.call @_QMoptPassumed_shape(%[[select]])
 134   call assumed_shape(x(55)%p)
 135 end subroutine
 136
 137 ! CHECK-LABEL: func @_QMoptPalloc_component_eval_only_once(
 138 subroutine alloc_component_eval_only_once(x)
 139   integer, external :: ifoo
 140   type(t) :: x(100)
 141   ! Verify that the index in the component reference are not evaluated twice
 142   ! because if the optional handling logic.
 143   ! CHECK: fir.call @_QPifoo()
 144   ! CHECK-NOT: fir.call @_QPifoo()
 145   call assumed_shape(x(ifoo())%p)
 146 end subroutine
 147
 148 ! CHECK-LABEL: func @_QMoptPnull_as_optional() {
 149 subroutine null_as_optional
 150   ! CHECK: %[[temp:.*]] = fir.alloca !fir.llvm_ptr<none>
 151   ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ref<none>
 152   ! CHECK: fir.store %{{.*}} to %[[temp]] : !fir.ref<!fir.llvm_ptr<none>>
 153   ! CHECK: fir.call @_QMoptPassumed_shape(%{{.*}}) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
 154  call assumed_shape(null())
 155 end subroutine null_as_optional
 156
 157 end module