flang/test/Transforms/stack-arrays.f90

   1 ! RUN: %flang_fc1 -emit-fir -flang-deprecated-no-hlfir %s -o - | fir-opt --array-value-copy | fir-opt --stack-arrays | FileCheck %s
   2
   3 ! In order to verify the whole MLIR pipeline, make the driver generate LLVM IR.
   4 ! This is only to check that -fstack-arrays enables the stack-arrays pass so
   5 ! only check the first example
   6 ! RUN: %flang_fc1 -emit-llvm -flang-deprecated-no-hlfir -o - -fstack-arrays %s | FileCheck --check-prefix=LLVM-IR %s
   7
   8 ! check simple array value copy case
   9 subroutine array_value_copy_simple(arr)
  10   integer, intent(inout) :: arr(4)
  11   arr(3:4) = arr(1:2)
  12 end subroutine
  13 ! CHECK-LABEL: func.func @_QParray_value_copy_simple(%arg0: !fir.ref<!fir.array<4xi32>>
  14 ! CHECK-NOT: fir.allocmem
  15 ! CHECK-NOT: fir.freemem
  16 ! CHECK: fir.alloca !fir.array<4xi32>
  17 ! CHECK-NOT: fir.allocmem
  18 ! CHECK-NOT: fir.freemem
  19 ! CHECK: return
  20 ! CHECK-NEXT: }
  21
  22 ! LLVM-IR: array_value_copy_simple
  23 ! LLVM-IR-NOT: malloc
  24 ! LLVM-IR-NOT: free
  25 ! LLVM-IR: alloca [4 x i32]
  26 ! LLVM-IR-NOT: malloc
  27 ! LLVM-IR-NOT: free
  28 ! LLVM-IR: ret void
  29 ! LLVM-IR-NEXT: }
  30
  31 ! check complex array value copy case
  32 module stuff
  33   type DerivedWithAllocatable
  34     integer, dimension(:), allocatable :: dat
  35   end type
  36
  37   contains
  38   subroutine array_value_copy_complex(arr)
  39     type(DerivedWithAllocatable), intent(inout) :: arr(:)
  40     arr(3:4) = arr(1:2)
  41   end subroutine
  42 end module
  43 ! CHECK: func.func
  44 ! CHECK-SAME: array_value_copy_complex
  45 ! CHECK-NOT: fir.allocmem
  46 ! CHECK-NOT: fir.freemem
  47 ! CHECK: fir.alloca !fir.array<?x!fir.type<_QMstuffTderivedwithallocatable
  48 ! CHECK-NOT: fir.allocmem
  49 ! CHECK-NOT: fir.freemem
  50 ! CHECK: return
  51 ! CHECK-NEXT: }
  52
  53 subroutine parameter_array_init
  54   integer, parameter :: p(100) = 42
  55   call use_p(p)
  56 end subroutine
  57 ! CHECK: func.func
  58 ! CHECK-SAME: parameter_array_init
  59 ! CHECK-NOT: fir.allocmem
  60 ! CHECK-NOT: fir.freemem
  61 ! CHECK: fir.alloca !fir.array<100xi32>
  62 ! CHECK-NOT: fir.allocmem
  63 ! CHECK-NOT: fir.freemem
  64 ! CHECK: return
  65 ! CHECK-NEXT: }
  66
  67 subroutine test_vector_subscripted_section_to_box(v, x)
  68   interface
  69     subroutine takes_box(y)
  70       real :: y(:)
  71     end subroutine
  72   end interface
  73
  74   integer :: v(:)
  75   real :: x(:)
  76   call takes_box(x(v))
  77 end subroutine
  78 ! CHECK: func.func
  79 ! CHECK-SAME: test_vector_subscripted_section_to_box
  80 ! CHECK-NOT: fir.allocmem
  81 ! CHECK: fir.alloca !fir.array<?xf32>
  82 ! CHECK-NOT: fir.allocmem
  83 ! CHECK: fir.call @_QPtakes_box
  84 ! CHECK-NOT: fir.freemem
  85 ! CHECK: return
  86 ! CHECK-NEXT: }
  87
  88 subroutine call_parenthesized_arg(x)
  89   integer :: x(100)
  90   call bar((x))
  91 end subroutine
  92 ! CHECK: func.func
  93 ! CHECK-SAME: call_parenthesized_arg
  94 ! CHECK-NOT: fir.allocmem
  95 ! CHECK: fir.alloca !fir.array<100xi32>
  96 ! CHECK-NOT: fir.allocmem
  97 ! CHECK: fir.call @_QPbar
  98 ! CHECK-NOT: fir.freemem
  99 ! CHECK: return
 100 ! CHECK-NEXT: }
 101
 102 subroutine where_allocatable_assignments(a, b)
 103   integer :: a(:)
 104   integer, allocatable :: b(:)
 105   where(b > 0)
 106     b = a
 107   elsewhere
 108     b(:) = 0
 109   end where
 110 end subroutine
 111 ! TODO: broken: passing allocation through fir.result
 112 ! CHECK: func.func
 113 ! CHECK-SAME: where_allocatable_assignments
 114 ! CHECK: return
 115 ! CHECK-NEXT: }
 116
 117 subroutine array_constructor(a, b)
 118   real :: a(5), b
 119   real, external :: f
 120   a = [f(b), f(b+1), f(b+2), f(b+5), f(b+11)]
 121 end subroutine
 122 ! TODO: broken: realloc
 123 ! CHECK: func.func
 124 ! CHECK-SAME: array_constructor
 125 ! CHECK: return
 126 ! CHECK-NEXT: }
 127
 128 subroutine sequence(seq, n)
 129   integer :: n, seq(n)
 130   seq = [(i,i=1,n)]
 131 end subroutine
 132 ! TODO: broken: realloc
 133 ! CHECK: func.func
 134 ! CHECK-SAME: sequence
 135 ! CHECK: return
 136 ! CHECK-NEXT: }
 137
 138 subroutine CFGLoop(x)
 139   integer, parameter :: k = 100, m=1000000, n = k*m
 140   integer :: x(n)
 141   logical :: has_error
 142
 143   do i=0,m-1
 144     x(k*i+1:k*(i+1)) = x(k*(i+1):k*i+1:-1)
 145     if (has_error(x, k)) stop
 146   end do
 147 end subroutine
 148 ! CHECK: func.func
 149 ! CHECK-SAME: cfgloop
 150 ! CHECK-NEXT: %[[MEM:.*]] = fir.alloca !fir.array<100000000xi32>
 151 ! CHECK-NOT: fir.allocmem
 152 ! CHECK-NOT: fir.freemem
 153 ! CHECK: return
 154 ! CHECK-NEXT: }