1! RUN: bbc -emit-fir %s -o - | FileCheck %s
2
3! Test OPTIONAL lowering on caller/callee and PRESENT intrinsic.
4module opt
5  implicit none
6  type t
7    real, allocatable :: p(:)
8  end type
9contains
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}) {
14subroutine intrinsic_scalar(x)
15  real, optional :: x
16  ! CHECK: fir.is_present %[[arg0]] : (!fir.ref<f32>) -> i1
17  print *, present(x)
18end subroutine
19! CHECK-LABEL: @_QMoptPcall_intrinsic_scalar()
20subroutine 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()
28end 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}) {
33subroutine 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)
37end subroutine
38! CHECK-LABEL: func @_QMoptPcall_intrinsic_f77_array()
39subroutine 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()
47end 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}) {
52subroutine 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)
57end subroutine
58! CHECK-LABEL: func @_QMoptPcall_character_scalar()
59subroutine 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()
69end 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}) {
74subroutine assumed_shape(x)
75  real, optional :: x(:)
76  ! CHECK: fir.is_present %[[arg0]] : (!fir.box<!fir.array<?xf32>>) -> i1
77  print *, present(x)
78end subroutine
79! CHECK: func @_QMoptPcall_assumed_shape()
80subroutine 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()
90end 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}) {
95subroutine 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)
99end subroutine
100! CHECK: func @_QMoptPcall_allocatable_array()
101subroutine 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()
109end subroutine
110
111! CHECK: func @_QMoptPallocatable_to_assumed_optional_array(
112! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>{{.*}}) {
113subroutine 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)
125end subroutine
126
127! CHECK-LABEL: func @_QMoptPalloc_component_to_optional_assumed_shape(
128subroutine 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)
135end subroutine
136
137! CHECK-LABEL: func @_QMoptPalloc_component_eval_only_once(
138subroutine 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)
146end subroutine
147
148! CHECK-LABEL: func @_QMoptPnull_as_optional() {
149subroutine 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())
155end subroutine null_as_optional
156
157end module
158