1! RUN: bbc -emit-fir %s -o - | FileCheck %s
2
3! Test lowering of allocatables using runtime for allocate/deallcoate statements.
4! CHECK-LABEL: _QPfooscalar
5subroutine fooscalar()
6  ! Test lowering of local allocatable specification
7  real, allocatable :: x
8  ! CHECK: %[[xAddrVar:.*]] = fir.alloca !fir.heap<f32> {{{.*}}uniq_name = "_QFfooscalarEx.addr"}
9  ! CHECK: %[[nullAddr:.*]] = fir.zero_bits !fir.heap<f32>
10  ! CHECK: fir.store %[[nullAddr]] to %[[xAddrVar]] : !fir.ref<!fir.heap<f32>>
11
12  ! Test allocation of local allocatables
13  allocate(x)
14  ! CHECK: %[[alloc:.*]] = fir.allocmem f32 {{{.*}}uniq_name = "_QFfooscalarEx.alloc"}
15  ! CHECK: fir.store %[[alloc]] to %[[xAddrVar]] : !fir.ref<!fir.heap<f32>>
16
17  ! Test reading allocatable bounds and extents
18  print *, x
19  ! CHECK: %[[xAddr1:.*]] = fir.load %[[xAddrVar]] : !fir.ref<!fir.heap<f32>>
20  ! CHECK: = fir.load %[[xAddr1]] : !fir.heap<f32>
21
22  ! Test deallocation
23  deallocate(x)
24  ! CHECK: %[[xAddr2:.*]] = fir.load %[[xAddrVar]] : !fir.ref<!fir.heap<f32>>
25  ! CHECK: fir.freemem %[[xAddr2]]
26  ! CHECK: %[[nullAddr1:.*]] = fir.zero_bits !fir.heap<f32>
27  ! fir.store %[[nullAddr1]] to %[[xAddrVar]] : !fir.ref<!fir.heap<f32>>
28end subroutine
29
30! CHECK-LABEL: _QPfoodim1
31subroutine foodim1()
32  ! Test lowering of local allocatable specification
33  real, allocatable :: x(:)
34  ! CHECK-DAG: %[[xAddrVar:.*]] = fir.alloca !fir.heap<!fir.array<?xf32>> {{{.*}}uniq_name = "_QFfoodim1Ex.addr"}
35  ! CHECK-DAG: %[[xLbVar:.*]] = fir.alloca index {{{.*}}uniq_name = "_QFfoodim1Ex.lb0"}
36  ! CHECK-DAG: %[[xExtVar:.*]] = fir.alloca index {{{.*}}uniq_name = "_QFfoodim1Ex.ext0"}
37  ! CHECK: %[[nullAddr:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
38  ! CHECK: fir.store %[[nullAddr]] to %[[xAddrVar]] : !fir.ref<!fir.heap<!fir.array<?xf32>>>
39
40  ! Test allocation of local allocatables
41  allocate(x(42:100))
42  ! CHECK-DAG: %[[c42:.*]] = fir.convert %c42{{.*}} : (i32) -> index
43  ! CHECK-DAG: %[[c100:.*]] = fir.convert %c100_i32 : (i32) -> index
44  ! CHECK-DAG: %[[diff:.*]] = arith.subi %[[c100]], %[[c42]] : index
45  ! CHECK: %[[rawExtent:.*]] = arith.addi %[[diff]], %c1{{.*}} : index
46  ! CHECK: %[[extentPositive:.*]] = arith.cmpi sgt, %[[rawExtent]], %c0{{.*}} : index
47  ! CHECK: %[[extent:.*]] = arith.select %[[extentPositive]], %[[rawExtent]], %c0{{.*}} : index
48  ! CHECK: %[[alloc:.*]] = fir.allocmem !fir.array<?xf32>, %[[extent]] {{{.*}}uniq_name = "_QFfoodim1Ex.alloc"}
49  ! CHECK-DAG: fir.store %[[alloc]] to %[[xAddrVar]] : !fir.ref<!fir.heap<!fir.array<?xf32>>>
50  ! CHECK-DAG: fir.store %[[extent]] to %[[xExtVar]] : !fir.ref<index>
51  ! CHECK-DAG: fir.store %[[c42]] to %[[xLbVar]] : !fir.ref<index>
52
53  ! Test reading allocatable bounds and extents
54  print *, x(42)
55  ! CHECK-DAG: fir.load %[[xLbVar]] : !fir.ref<index>
56  ! CHECK-DAG: fir.load %[[xAddrVar]] : !fir.ref<!fir.heap<!fir.array<?xf32>>>
57
58  deallocate(x)
59  ! CHECK: %[[xAddr1:.*]] = fir.load %1 : !fir.ref<!fir.heap<!fir.array<?xf32>>>
60  ! CHECK: fir.freemem %[[xAddr1]]
61  ! CHECK: %[[nullAddr1:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
62  ! CHECK: fir.store %[[nullAddr1]] to %[[xAddrVar]] : !fir.ref<!fir.heap<!fir.array<?xf32>>>
63end subroutine
64
65! CHECK-LABEL: _QPfoodim2
66subroutine foodim2()
67  ! Test lowering of local allocatable specification
68  real, allocatable :: x(:, :)
69  ! CHECK-DAG: fir.alloca !fir.heap<!fir.array<?x?xf32>> {{{.*}}uniq_name = "_QFfoodim2Ex.addr"}
70  ! CHECK-DAG: fir.alloca index {{{.*}}uniq_name = "_QFfoodim2Ex.lb0"}
71  ! CHECK-DAG: fir.alloca index {{{.*}}uniq_name = "_QFfoodim2Ex.ext0"}
72  ! CHECK-DAG: fir.alloca index {{{.*}}uniq_name = "_QFfoodim2Ex.lb1"}
73  ! CHECK-DAG: fir.alloca index {{{.*}}uniq_name = "_QFfoodim2Ex.ext1"}
74end subroutine
75
76! test lowering of character allocatables. Focus is placed on the length handling
77! CHECK-LABEL: _QPchar_deferred(
78subroutine char_deferred(n)
79  integer :: n
80  character(:), allocatable :: c
81  ! CHECK-DAG: %[[cAddrVar:.*]] = fir.alloca !fir.heap<!fir.char<1,?>> {{{.*}}uniq_name = "_QFchar_deferredEc.addr"}
82  ! CHECK-DAG: %[[cLenVar:.*]] = fir.alloca index {{{.*}}uniq_name = "_QFchar_deferredEc.len"}
83  allocate(character(10):: c)
84  ! CHECK: %[[c10:.]] = fir.convert %c10_i32 : (i32) -> index
85  ! CHECK: fir.allocmem !fir.char<1,?>(%[[c10]] : index) {{{.*}}uniq_name = "_QFchar_deferredEc.alloc"}
86  ! CHECK: fir.store %[[c10]] to %[[cLenVar]] : !fir.ref<index>
87  deallocate(c)
88  ! CHECK: fir.freemem %{{.*}}
89  allocate(character(n):: c)
90  ! CHECK: %[[n:.*]] = fir.load %arg0 : !fir.ref<i32>
91  ! CHECK: %[[nPositive:.*]] = arith.cmpi sgt, %[[n]], %c0{{.*}} : i32
92  ! CHECK: %[[ns:.*]] = arith.select %[[nPositive]], %[[n]], %c0{{.*}} : i32
93  ! CHECK: %[[ni:.*]] = fir.convert %[[ns]] : (i32) -> index
94  ! CHECK: fir.allocmem !fir.char<1,?>(%[[ni]] : index) {{{.*}}uniq_name = "_QFchar_deferredEc.alloc"}
95  ! CHECK: fir.store %[[ni]] to %[[cLenVar]] : !fir.ref<index>
96
97  call bar(c)
98  ! CHECK-DAG: %[[cLen:.*]] = fir.load %[[cLenVar]] : !fir.ref<index>
99  ! CHECK-DAG: %[[cAddr:.*]] = fir.load %[[cAddrVar]] : !fir.ref<!fir.heap<!fir.char<1,?>>>
100  ! CHECK-DAG: %[[cAddrcast:.*]] = fir.convert %[[cAddr]] : (!fir.heap<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,?>>
101  ! CHECK: fir.emboxchar %[[cAddrcast]], %[[cLen]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
102end subroutine
103
104! CHECK-LABEL: _QPchar_explicit_cst(
105subroutine char_explicit_cst(n)
106  integer :: n
107  character(10), allocatable :: c
108  ! CHECK-DAG: %[[cLen:.*]] = arith.constant 10 : index
109  ! CHECK-DAG: %[[cAddrVar:.*]] = fir.alloca !fir.heap<!fir.char<1,10>> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.addr"}
110  ! CHECK-NOT: "_QFchar_explicit_cstEc.len"
111  allocate(c)
112  ! CHECK: fir.allocmem !fir.char<1,10> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.alloc"}
113  deallocate(c)
114  ! CHECK: fir.freemem %{{.*}}
115  allocate(character(n):: c)
116  ! CHECK: fir.allocmem !fir.char<1,10> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.alloc"}
117  deallocate(c)
118  ! CHECK: fir.freemem %{{.*}}
119  allocate(character(10):: c)
120  ! CHECK: fir.allocmem !fir.char<1,10> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.alloc"}
121  call bar(c)
122  ! CHECK: %[[cAddr:.*]] = fir.load %[[cAddrVar]] : !fir.ref<!fir.heap<!fir.char<1,10>>>
123  ! CHECK: %[[cAddrcast:.*]] = fir.convert %[[cAddr]] : (!fir.heap<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,?>>
124  ! CHECK: fir.emboxchar %[[cAddrcast]], %[[cLen]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
125end subroutine
126
127! CHECK-LABEL: _QPchar_explicit_dyn(
128subroutine char_explicit_dyn(l1, l2)
129  integer :: l1, l2
130  character(l1), allocatable :: c
131  ! CHECK: %[[l1:.*]] = fir.load %arg0 : !fir.ref<i32>
132  ! CHECK: %[[c0_i32:.*]] = arith.constant 0 : i32
133  ! CHECK: %[[cmp:.*]] = arith.cmpi sgt, %[[l1]], %[[c0_i32]] : i32
134  ! CHECK: %[[cLen:.*]] = arith.select %[[cmp]], %[[l1]], %[[c0_i32]] : i32
135  ! CHECK: %[[cAddrVar:.*]] = fir.alloca !fir.heap<!fir.char<1,?>> {{{.*}}uniq_name = "_QFchar_explicit_dynEc.addr"}
136  ! CHECK-NOT: "_QFchar_explicit_dynEc.len"
137  allocate(c)
138  ! CHECK: %[[cLenCast1:.*]] = fir.convert %[[cLen]] : (i32) -> index
139  ! CHECK: fir.allocmem !fir.char<1,?>(%[[cLenCast1]] : index) {{{.*}}uniq_name = "_QFchar_explicit_dynEc.alloc"}
140  deallocate(c)
141  ! CHECK: fir.freemem %{{.*}}
142  allocate(character(l2):: c)
143  ! CHECK: %[[cLenCast2:.*]] = fir.convert %[[cLen]] : (i32) -> index
144  ! CHECK: fir.allocmem !fir.char<1,?>(%[[cLenCast2]] : index) {{{.*}}uniq_name = "_QFchar_explicit_dynEc.alloc"}
145  deallocate(c)
146  ! CHECK: fir.freemem %{{.*}}
147  allocate(character(10):: c)
148  ! CHECK: %[[cLenCast3:.*]] = fir.convert %[[cLen]] : (i32) -> index
149  ! CHECK: fir.allocmem !fir.char<1,?>(%[[cLenCast3]] : index) {{{.*}}uniq_name = "_QFchar_explicit_dynEc.alloc"}
150  call bar(c)
151  ! CHECK-DAG: %[[cLenCast4:.*]] = fir.convert %[[cLen]] : (i32) -> index
152  ! CHECK-DAG: %[[cAddr:.*]] = fir.load %[[cAddrVar]] : !fir.ref<!fir.heap<!fir.char<1,?>>>
153  ! CHECK-DAG: %[[cAddrcast:.*]] = fir.convert %[[cAddr]] : (!fir.heap<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,?>>
154  ! CHECK: fir.emboxchar %[[cAddrcast]], %[[cLenCast4]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
155end subroutine
156
157! CHECK-LABEL: _QPspecifiers(
158subroutine specifiers
159  allocatable jj1(:), jj2(:,:), jj3(:)
160  ! CHECK: [[STAT:%[0-9]+]] = fir.alloca i32 {{{.*}}uniq_name = "_QFspecifiersEsss"}
161  integer sss
162  character*30 :: mmm = "None"
163  ! CHECK: fir.call @_FortranAAllocatableSetBounds
164  ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
165  ! CHECK: fir.store [[RESULT]] to [[STAT]]
166  ! CHECK: fir.if %{{[0-9]+}} {
167  ! CHECK: fir.call @_FortranAAllocatableSetBounds
168  ! CHECK: fir.call @_FortranAAllocatableSetBounds
169  ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
170  ! CHECK: fir.store [[RESULT]] to [[STAT]]
171  ! CHECK: fir.if %{{[0-9]+}} {
172  ! CHECK: fir.call @_FortranAAllocatableSetBounds
173  ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
174  ! CHECK: fir.store [[RESULT]] to [[STAT]]
175  ! CHECK-NOT: fir.if %{{[0-9]+}} {
176  ! CHECK-COUNT-2: }
177  ! CHECK-NOT: }
178  allocate(jj1(3), jj2(3,3), jj3(3), stat=sss, errmsg=mmm)
179  ! CHECK: fir.call @_FortranAAllocatableSetBounds
180  ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
181  ! CHECK: fir.call @_FortranAAllocatableSetBounds
182  ! CHECK: fir.call @_FortranAAllocatableSetBounds
183  ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
184  ! CHECK: fir.call @_FortranAAllocatableSetBounds
185  ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
186  allocate(jj1(3), jj2(3,3), jj3(3), stat=sss, errmsg=mmm)
187  ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
188  ! CHECK: fir.store [[RESULT]] to [[STAT]]
189  ! CHECK: fir.if %{{[0-9]+}} {
190  ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
191  ! CHECK: fir.store [[RESULT]] to [[STAT]]
192  ! CHECK: fir.if %{{[0-9]+}} {
193  ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
194  ! CHECK: fir.store [[RESULT]] to [[STAT]]
195  ! CHECK-NOT: fir.if %{{[0-9]+}} {
196  ! CHECK-COUNT-2: }
197  ! CHECK-NOT: }
198  deallocate(jj1, jj2, jj3, stat=sss, errmsg=mmm)
199  ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
200  ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
201  ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
202  deallocate(jj1, jj2, jj3, stat=sss, errmsg=mmm)
203end subroutine specifiers
204