flang/test/Lower/allocatables.f90

   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
   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-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>
 102 end subroutine
 103
 104 ! CHECK-LABEL: _QPchar_explicit_cst(
 105 subroutine 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>
 125 end subroutine
 126
 127 ! CHECK-LABEL: _QPchar_explicit_dyn(
 128 subroutine 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>
 155 end subroutine
 156
 157 ! CHECK-LABEL: _QPspecifiers(
 158 subroutine 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)
 203 end subroutine specifiers