flang/test/Lower/allocatables.f90

   1 ! RUN: bbc --use-desc-for-alloc=false -emit-fir %s -o - | FileCheck %s
   2
   3 ! Test lowering of allocatables using runtime for allocate/deallcoate statements.
   4 ! CHECK-LABEL: _QPfooscalar
   5 subroutine 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>>
  28 end subroutine
  29
  30 ! CHECK-LABEL: _QPfoodim1
  31 subroutine 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>>>
  63 end subroutine
  64
  65 ! CHECK-LABEL: _QPfoodim2
  66 subroutine 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"}
  74 end subroutine
  75
  76 ! test lowering of character allocatables. Focus is placed on the length handling
  77 ! CHECK-LABEL: _QPchar_deferred(
  78 subroutine 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>
 101 end subroutine
 102
 103 ! CHECK-LABEL: _QPchar_explicit_cst(
 104 subroutine 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>
 123 end subroutine
 124
 125 ! CHECK-LABEL: _QPchar_explicit_dyn(
 126 subroutine 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>
 152 end subroutine
 153
 154 ! CHECK-LABEL: _QPspecifiers(
 155 subroutine 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)
 200 end subroutine specifiers