llvm-project/flang/test/Lower/allocatables.f90
Susan Tan (ス-ザン タン) bf3b704c60
[flang][NFC] Characterize allocation based on MemAlloc effect instead of pattern matching (#166806)
Flang alias analysis used to find allocation site by pattern matching
allocation ops in mainly FIR dialect. This MR extends the
characterization to instead characterize based on whether the result of
an op has MemAlloc effect.
2025-11-10 17:33:43 -05:00

197 lines
9.5 KiB
Fortran

! RUN: bbc --use-desc-for-alloc=false -emit-fir -hlfir=false %s -o - | FileCheck %s
! Test lowering of allocatables using runtime for allocate/deallcoate statements.
! CHECK-LABEL: _QPfooscalar
subroutine fooscalar()
! Test lowering of local allocatable specification
real, allocatable :: x
! CHECK: %[[xAddrVar:.*]] = fir.alloca !fir.heap<f32> {{{.*}}uniq_name = "_QFfooscalarEx.addr"}
! CHECK: %[[nullAddr:.*]] = fir.zero_bits !fir.heap<f32>
! CHECK: fir.store %[[nullAddr]] to %[[xAddrVar]] : !fir.ref<!fir.heap<f32>>
! Test allocation of local allocatables
allocate(x)
! CHECK: %[[alloc:.*]] = fir.allocmem f32 {{{.*}}uniq_name = "_QFfooscalarEx.alloc"}
! CHECK: fir.store %[[alloc]] to %[[xAddrVar]] : !fir.ref<!fir.heap<f32>>
! Test reading allocatable bounds and extents
print *, x
! CHECK: %[[xAddr1:.*]] = fir.load %[[xAddrVar]] : !fir.ref<!fir.heap<f32>>
! CHECK: = fir.load %[[xAddr1]] : !fir.heap<f32>
! Test deallocation
deallocate(x)
! CHECK: %[[xAddr2:.*]] = fir.load %[[xAddrVar]] : !fir.ref<!fir.heap<f32>>
! CHECK: fir.freemem %[[xAddr2]]
! CHECK: %[[nullAddr1:.*]] = fir.zero_bits !fir.heap<f32>
! fir.store %[[nullAddr1]] to %[[xAddrVar]] : !fir.ref<!fir.heap<f32>>
end subroutine
! CHECK-LABEL: _QPfoodim1
subroutine foodim1()
! Test lowering of local allocatable specification
real, allocatable :: x(:)
! CHECK-DAG: %[[xAddrVar:.*]] = fir.alloca !fir.heap<!fir.array<?xf32>> {{{.*}}uniq_name = "_QFfoodim1Ex.addr"}
! CHECK-DAG: %[[xLbVar:.*]] = fir.alloca index {{{.*}}uniq_name = "_QFfoodim1Ex.lb0"}
! CHECK-DAG: %[[xExtVar:.*]] = fir.alloca index {{{.*}}uniq_name = "_QFfoodim1Ex.ext0"}
! CHECK: %[[nullAddr:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
! CHECK: fir.store %[[nullAddr]] to %[[xAddrVar]] : !fir.ref<!fir.heap<!fir.array<?xf32>>>
! Test allocation of local allocatables
allocate(x(42:100))
! CHECK-DAG: %[[c42:.*]] = fir.convert %c42{{.*}} : (i32) -> index
! CHECK-DAG: %[[c100:.*]] = fir.convert %c100_i32 : (i32) -> index
! CHECK-DAG: %[[diff:.*]] = arith.subi %[[c100]], %[[c42]] : index
! CHECK: %[[rawExtent:.*]] = arith.addi %[[diff]], %c1{{.*}} : index
! CHECK: %[[extentPositive:.*]] = arith.cmpi sgt, %[[rawExtent]], %c0{{.*}} : index
! CHECK: %[[extent:.*]] = arith.select %[[extentPositive]], %[[rawExtent]], %c0{{.*}} : index
! CHECK: %[[alloc:.*]] = fir.allocmem !fir.array<?xf32>, %[[extent]] {{{.*}}uniq_name = "_QFfoodim1Ex.alloc"}
! CHECK-DAG: fir.store %[[alloc]] to %[[xAddrVar]] : !fir.ref<!fir.heap<!fir.array<?xf32>>>
! CHECK-DAG: fir.store %[[extent]] to %[[xExtVar]] : !fir.ref<index>
! CHECK-DAG: fir.store %[[c42]] to %[[xLbVar]] : !fir.ref<index>
! Test reading allocatable bounds and extents
print *, x(42)
! CHECK-DAG: fir.load %[[xLbVar]] : !fir.ref<index>
! CHECK-DAG: fir.load %[[xAddrVar]] : !fir.ref<!fir.heap<!fir.array<?xf32>>>
deallocate(x)
! CHECK: %[[xAddr1:.*]] = fir.load %{{.*}} : !fir.ref<!fir.heap<!fir.array<?xf32>>>
! CHECK: fir.freemem %[[xAddr1]]
! CHECK: %[[nullAddr1:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
! CHECK: fir.store %[[nullAddr1]] to %[[xAddrVar]] : !fir.ref<!fir.heap<!fir.array<?xf32>>>
end subroutine
! CHECK-LABEL: _QPfoodim2
subroutine foodim2()
! Test lowering of local allocatable specification
real, allocatable :: x(:, :)
! CHECK-DAG: fir.alloca !fir.heap<!fir.array<?x?xf32>> {{{.*}}uniq_name = "_QFfoodim2Ex.addr"}
end subroutine
! test lowering of character allocatables. Focus is placed on the length handling
! CHECK-LABEL: _QPchar_deferred(
subroutine char_deferred(n)
integer :: n
character(:), allocatable :: c
! CHECK-DAG: %[[cAddrVar:.*]] = fir.alloca !fir.heap<!fir.char<1,?>> {{{.*}}uniq_name = "_QFchar_deferredEc.addr"}
! CHECK-DAG: %[[cLenVar:.*]] = fir.alloca index {{{.*}}uniq_name = "_QFchar_deferredEc.len"}
allocate(character(10):: c)
! CHECK: %[[c10:.]] = fir.convert %c10_i32 : (i32) -> index
! CHECK: fir.allocmem !fir.char<1,?>(%[[c10]] : index) {{{.*}}uniq_name = "_QFchar_deferredEc.alloc"}
! CHECK: fir.store %[[c10]] to %[[cLenVar]] : !fir.ref<index>
deallocate(c)
! CHECK: fir.freemem %{{.*}}
allocate(character(n):: c)
! CHECK: %[[n:.*]] = fir.load %arg0 : !fir.ref<i32>
! CHECK: %[[nPositive:.*]] = arith.cmpi sgt, %[[n]], %c0{{.*}} : i32
! CHECK: %[[ns:.*]] = arith.select %[[nPositive]], %[[n]], %c0{{.*}} : i32
! CHECK: %[[ni:.*]] = fir.convert %[[ns]] : (i32) -> index
! CHECK: fir.allocmem !fir.char<1,?>(%[[ni]] : index) {{{.*}}uniq_name = "_QFchar_deferredEc.alloc"}
! CHECK: fir.store %[[ni]] to %[[cLenVar]] : !fir.ref<index>
call bar(c)
! CHECK-DAG: %[[cLen:.*]] = fir.load %[[cLenVar]] : !fir.ref<index>
! CHECK-DAG: %[[cAddr:.*]] = fir.load %[[cAddrVar]] : !fir.ref<!fir.heap<!fir.char<1,?>>>
! CHECK: fir.emboxchar %[[cAddr]], %[[cLen]] : (!fir.heap<!fir.char<1,?>>, index) -> !fir.boxchar<1>
end subroutine
! CHECK-LABEL: _QPchar_explicit_cst(
subroutine char_explicit_cst(n)
integer :: n
character(10), allocatable :: c
! CHECK-DAG: %[[cLen:.*]] = arith.constant 10 : index
! CHECK-DAG: %[[cAddrVar:.*]] = fir.alloca !fir.heap<!fir.char<1,10>> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.addr"}
! CHECK-NOT: "_QFchar_explicit_cstEc.len"
allocate(c)
! CHECK: fir.allocmem !fir.char<1,10> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.alloc"}
deallocate(c)
! CHECK: fir.freemem %{{.*}}
allocate(character(n):: c)
! CHECK: fir.allocmem !fir.char<1,10> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.alloc"}
deallocate(c)
! CHECK: fir.freemem %{{.*}}
allocate(character(10):: c)
! CHECK: fir.allocmem !fir.char<1,10> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.alloc"}
call bar(c)
! CHECK: %[[cAddr:.*]] = fir.load %[[cAddrVar]] : !fir.ref<!fir.heap<!fir.char<1,10>>>
! CHECK: fir.emboxchar %[[cAddr]], %[[cLen]] : (!fir.heap<!fir.char<1,10>>, index) -> !fir.boxchar<1>
end subroutine
! CHECK-LABEL: _QPchar_explicit_dyn(
subroutine char_explicit_dyn(l1, l2)
integer :: l1, l2
character(l1), allocatable :: c
! CHECK: %[[l1:.*]] = fir.load %arg0 : !fir.ref<i32>
! CHECK: %[[c0_i32:.*]] = arith.constant 0 : i32
! CHECK: %[[cmp:.*]] = arith.cmpi sgt, %[[l1]], %[[c0_i32]] : i32
! CHECK: %[[cLen:.*]] = arith.select %[[cmp]], %[[l1]], %[[c0_i32]] : i32
! CHECK: %[[cAddrVar:.*]] = fir.alloca !fir.heap<!fir.char<1,?>> {{{.*}}uniq_name = "_QFchar_explicit_dynEc.addr"}
! CHECK-NOT: "_QFchar_explicit_dynEc.len"
allocate(c)
! CHECK: %[[cLenCast1:.*]] = fir.convert %[[cLen]] : (i32) -> index
! CHECK: fir.allocmem !fir.char<1,?>(%[[cLenCast1]] : index) {{{.*}}uniq_name = "_QFchar_explicit_dynEc.alloc"}
deallocate(c)
! CHECK: fir.freemem %{{.*}}
allocate(character(l2):: c)
! CHECK: %[[cLenCast2:.*]] = fir.convert %[[cLen]] : (i32) -> index
! CHECK: fir.allocmem !fir.char<1,?>(%[[cLenCast2]] : index) {{{.*}}uniq_name = "_QFchar_explicit_dynEc.alloc"}
deallocate(c)
! CHECK: fir.freemem %{{.*}}
allocate(character(10):: c)
! CHECK: %[[cLenCast3:.*]] = fir.convert %[[cLen]] : (i32) -> index
! CHECK: fir.allocmem !fir.char<1,?>(%[[cLenCast3]] : index) {{{.*}}uniq_name = "_QFchar_explicit_dynEc.alloc"}
call bar(c)
! CHECK-DAG: %[[cLenCast4:.*]] = fir.convert %[[cLen]] : (i32) -> index
! CHECK-DAG: %[[cAddr:.*]] = fir.load %[[cAddrVar]] : !fir.ref<!fir.heap<!fir.char<1,?>>>
! CHECK: fir.emboxchar %[[cAddr]], %[[cLenCast4]] : (!fir.heap<!fir.char<1,?>>, index) -> !fir.boxchar<1>
end subroutine
! CHECK-LABEL: _QPspecifiers(
subroutine specifiers
allocatable jj1(:), jj2(:,:), jj3(:)
! CHECK: [[STAT:%[0-9]+]] = fir.alloca i32 {{{.*}}uniq_name = "_QFspecifiersEsss"}
integer sss
character*30 :: mmm = "None"
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
! CHECK: fir.store [[RESULT]] to [[STAT]]
! CHECK: fir.if %{{[0-9]+}} {
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
! CHECK: fir.store [[RESULT]] to [[STAT]]
! CHECK: fir.if %{{[0-9]+}} {
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
! CHECK: fir.store [[RESULT]] to [[STAT]]
! CHECK-NOT: fir.if %{{[0-9]+}} {
! CHECK-COUNT-2: }
! CHECK-NOT: }
allocate(jj1(3), jj2(3,3), jj3(3), stat=sss, errmsg=mmm)
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
allocate(jj1(3), jj2(3,3), jj3(3), stat=sss, errmsg=mmm)
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
! CHECK: fir.store [[RESULT]] to [[STAT]]
! CHECK: fir.if %{{[0-9]+}} {
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
! CHECK: fir.store [[RESULT]] to [[STAT]]
! CHECK: fir.if %{{[0-9]+}} {
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
! CHECK: fir.store [[RESULT]] to [[STAT]]
! CHECK-NOT: fir.if %{{[0-9]+}} {
! CHECK-COUNT-2: }
! CHECK-NOT: }
deallocate(jj1, jj2, jj3, stat=sss, errmsg=mmm)
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
deallocate(jj1, jj2, jj3, stat=sss, errmsg=mmm)
end subroutine specifiers