1! RUN: bbc --use-desc-for-alloc=false -emit-fir -hlfir=false %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: fir.emboxchar %[[cAddr]], %[[cLen]] : (!fir.heap<!fir.char<1,?>>, index) -> !fir.boxchar<1> 101end subroutine 102 103! CHECK-LABEL: _QPchar_explicit_cst( 104subroutine char_explicit_cst(n) 105 integer :: n 106 character(10), allocatable :: c 107 ! CHECK-DAG: %[[cLen:.*]] = arith.constant 10 : index 108 ! CHECK-DAG: %[[cAddrVar:.*]] = fir.alloca !fir.heap<!fir.char<1,10>> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.addr"} 109 ! CHECK-NOT: "_QFchar_explicit_cstEc.len" 110 allocate(c) 111 ! CHECK: fir.allocmem !fir.char<1,10> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.alloc"} 112 deallocate(c) 113 ! CHECK: fir.freemem %{{.*}} 114 allocate(character(n):: c) 115 ! CHECK: fir.allocmem !fir.char<1,10> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.alloc"} 116 deallocate(c) 117 ! CHECK: fir.freemem %{{.*}} 118 allocate(character(10):: c) 119 ! CHECK: fir.allocmem !fir.char<1,10> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.alloc"} 120 call bar(c) 121 ! CHECK: %[[cAddr:.*]] = fir.load %[[cAddrVar]] : !fir.ref<!fir.heap<!fir.char<1,10>>> 122 ! CHECK: fir.emboxchar %[[cAddr]], %[[cLen]] : (!fir.heap<!fir.char<1,10>>, index) -> !fir.boxchar<1> 123end subroutine 124 125! CHECK-LABEL: _QPchar_explicit_dyn( 126subroutine char_explicit_dyn(l1, l2) 127 integer :: l1, l2 128 character(l1), allocatable :: c 129 ! CHECK: %[[l1:.*]] = fir.load %arg0 : !fir.ref<i32> 130 ! CHECK: %[[c0_i32:.*]] = arith.constant 0 : i32 131 ! CHECK: %[[cmp:.*]] = arith.cmpi sgt, %[[l1]], %[[c0_i32]] : i32 132 ! CHECK: %[[cLen:.*]] = arith.select %[[cmp]], %[[l1]], %[[c0_i32]] : i32 133 ! CHECK: %[[cAddrVar:.*]] = fir.alloca !fir.heap<!fir.char<1,?>> {{{.*}}uniq_name = "_QFchar_explicit_dynEc.addr"} 134 ! CHECK-NOT: "_QFchar_explicit_dynEc.len" 135 allocate(c) 136 ! CHECK: %[[cLenCast1:.*]] = fir.convert %[[cLen]] : (i32) -> index 137 ! CHECK: fir.allocmem !fir.char<1,?>(%[[cLenCast1]] : index) {{{.*}}uniq_name = "_QFchar_explicit_dynEc.alloc"} 138 deallocate(c) 139 ! CHECK: fir.freemem %{{.*}} 140 allocate(character(l2):: c) 141 ! CHECK: %[[cLenCast2:.*]] = fir.convert %[[cLen]] : (i32) -> index 142 ! CHECK: fir.allocmem !fir.char<1,?>(%[[cLenCast2]] : index) {{{.*}}uniq_name = "_QFchar_explicit_dynEc.alloc"} 143 deallocate(c) 144 ! CHECK: fir.freemem %{{.*}} 145 allocate(character(10):: c) 146 ! CHECK: %[[cLenCast3:.*]] = fir.convert %[[cLen]] : (i32) -> index 147 ! CHECK: fir.allocmem !fir.char<1,?>(%[[cLenCast3]] : index) {{{.*}}uniq_name = "_QFchar_explicit_dynEc.alloc"} 148 call bar(c) 149 ! CHECK-DAG: %[[cLenCast4:.*]] = fir.convert %[[cLen]] : (i32) -> index 150 ! CHECK-DAG: %[[cAddr:.*]] = fir.load %[[cAddrVar]] : !fir.ref<!fir.heap<!fir.char<1,?>>> 151 ! CHECK: fir.emboxchar %[[cAddr]], %[[cLenCast4]] : (!fir.heap<!fir.char<1,?>>, index) -> !fir.boxchar<1> 152end subroutine 153 154! CHECK-LABEL: _QPspecifiers( 155subroutine specifiers 156 allocatable jj1(:), jj2(:,:), jj3(:) 157 ! CHECK: [[STAT:%[0-9]+]] = fir.alloca i32 {{{.*}}uniq_name = "_QFspecifiersEsss"} 158 integer sss 159 character*30 :: mmm = "None" 160 ! CHECK: fir.call @_FortranAAllocatableSetBounds 161 ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate 162 ! CHECK: fir.store [[RESULT]] to [[STAT]] 163 ! CHECK: fir.if %{{[0-9]+}} { 164 ! CHECK: fir.call @_FortranAAllocatableSetBounds 165 ! CHECK: fir.call @_FortranAAllocatableSetBounds 166 ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate 167 ! CHECK: fir.store [[RESULT]] to [[STAT]] 168 ! CHECK: fir.if %{{[0-9]+}} { 169 ! CHECK: fir.call @_FortranAAllocatableSetBounds 170 ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate 171 ! CHECK: fir.store [[RESULT]] to [[STAT]] 172 ! CHECK-NOT: fir.if %{{[0-9]+}} { 173 ! CHECK-COUNT-2: } 174 ! CHECK-NOT: } 175 allocate(jj1(3), jj2(3,3), jj3(3), stat=sss, errmsg=mmm) 176 ! CHECK: fir.call @_FortranAAllocatableSetBounds 177 ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate 178 ! CHECK: fir.call @_FortranAAllocatableSetBounds 179 ! CHECK: fir.call @_FortranAAllocatableSetBounds 180 ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate 181 ! CHECK: fir.call @_FortranAAllocatableSetBounds 182 ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate 183 allocate(jj1(3), jj2(3,3), jj3(3), stat=sss, errmsg=mmm) 184 ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate 185 ! CHECK: fir.store [[RESULT]] to [[STAT]] 186 ! CHECK: fir.if %{{[0-9]+}} { 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-NOT: fir.if %{{[0-9]+}} { 193 ! CHECK-COUNT-2: } 194 ! CHECK-NOT: } 195 deallocate(jj1, jj2, jj3, stat=sss, errmsg=mmm) 196 ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate 197 ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate 198 ! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate 199 deallocate(jj1, jj2, jj3, stat=sss, errmsg=mmm) 200end subroutine specifiers 201