| ! 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 %1 : !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"} |
| ! CHECK-DAG: fir.alloca index {{{.*}}uniq_name = "_QFfoodim2Ex.lb0"} |
| ! CHECK-DAG: fir.alloca index {{{.*}}uniq_name = "_QFfoodim2Ex.ext0"} |
| ! CHECK-DAG: fir.alloca index {{{.*}}uniq_name = "_QFfoodim2Ex.lb1"} |
| ! CHECK-DAG: fir.alloca index {{{.*}}uniq_name = "_QFfoodim2Ex.ext1"} |
| 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 |