154 lines
3.8 KiB
Fortran
154 lines
3.8 KiB
Fortran
! RUN: %flang_fc1 -emit-fir -flang-deprecated-no-hlfir %s -o - | fir-opt --array-value-copy | fir-opt --stack-arrays | FileCheck %s
|
|
|
|
! In order to verify the whole MLIR pipeline, make the driver generate LLVM IR.
|
|
! This is only to check that -fstack-arrays enables the stack-arrays pass so
|
|
! only check the first example
|
|
! RUN: %flang_fc1 -emit-llvm -flang-deprecated-no-hlfir -o - -fstack-arrays %s | FileCheck --check-prefix=LLVM-IR %s
|
|
|
|
! check simple array value copy case
|
|
subroutine array_value_copy_simple(arr)
|
|
integer, intent(inout) :: arr(4)
|
|
arr(3:4) = arr(1:2)
|
|
end subroutine
|
|
! CHECK-LABEL: func.func @_QParray_value_copy_simple(%arg0: !fir.ref<!fir.array<4xi32>>
|
|
! CHECK-NOT: fir.allocmem
|
|
! CHECK-NOT: fir.freemem
|
|
! CHECK: fir.alloca !fir.array<4xi32>
|
|
! CHECK-NOT: fir.allocmem
|
|
! CHECK-NOT: fir.freemem
|
|
! CHECK: return
|
|
! CHECK-NEXT: }
|
|
|
|
! LLVM-IR: array_value_copy_simple
|
|
! LLVM-IR-NOT: malloc
|
|
! LLVM-IR-NOT: free
|
|
! LLVM-IR: alloca [4 x i32]
|
|
! LLVM-IR-NOT: malloc
|
|
! LLVM-IR-NOT: free
|
|
! LLVM-IR: ret void
|
|
! LLVM-IR-NEXT: }
|
|
|
|
! check complex array value copy case
|
|
module stuff
|
|
type DerivedWithAllocatable
|
|
integer, dimension(:), allocatable :: dat
|
|
end type
|
|
|
|
contains
|
|
subroutine array_value_copy_complex(arr)
|
|
type(DerivedWithAllocatable), intent(inout) :: arr(:)
|
|
arr(3:4) = arr(1:2)
|
|
end subroutine
|
|
end module
|
|
! CHECK: func.func
|
|
! CHECK-SAME: array_value_copy_complex
|
|
! CHECK-NOT: fir.allocmem
|
|
! CHECK-NOT: fir.freemem
|
|
! CHECK: fir.alloca !fir.array<?x!fir.type<_QMstuffTderivedwithallocatable
|
|
! CHECK-NOT: fir.allocmem
|
|
! CHECK-NOT: fir.freemem
|
|
! CHECK: return
|
|
! CHECK-NEXT: }
|
|
|
|
subroutine parameter_array_init
|
|
integer, parameter :: p(100) = 42
|
|
call use_p(p)
|
|
end subroutine
|
|
! CHECK: func.func
|
|
! CHECK-SAME: parameter_array_init
|
|
! CHECK-NOT: fir.allocmem
|
|
! CHECK-NOT: fir.freemem
|
|
! CHECK: fir.alloca !fir.array<100xi32>
|
|
! CHECK-NOT: fir.allocmem
|
|
! CHECK-NOT: fir.freemem
|
|
! CHECK: return
|
|
! CHECK-NEXT: }
|
|
|
|
subroutine test_vector_subscripted_section_to_box(v, x)
|
|
interface
|
|
subroutine takes_box(y)
|
|
real :: y(:)
|
|
end subroutine
|
|
end interface
|
|
|
|
integer :: v(:)
|
|
real :: x(:)
|
|
call takes_box(x(v))
|
|
end subroutine
|
|
! CHECK: func.func
|
|
! CHECK-SAME: test_vector_subscripted_section_to_box
|
|
! CHECK-NOT: fir.allocmem
|
|
! CHECK: fir.alloca !fir.array<?xf32>
|
|
! CHECK-NOT: fir.allocmem
|
|
! CHECK: fir.call @_QPtakes_box
|
|
! CHECK-NOT: fir.freemem
|
|
! CHECK: return
|
|
! CHECK-NEXT: }
|
|
|
|
subroutine call_parenthesized_arg(x)
|
|
integer :: x(100)
|
|
call bar((x))
|
|
end subroutine
|
|
! CHECK: func.func
|
|
! CHECK-SAME: call_parenthesized_arg
|
|
! CHECK-NOT: fir.allocmem
|
|
! CHECK: fir.alloca !fir.array<100xi32>
|
|
! CHECK-NOT: fir.allocmem
|
|
! CHECK: fir.call @_QPbar
|
|
! CHECK-NOT: fir.freemem
|
|
! CHECK: return
|
|
! CHECK-NEXT: }
|
|
|
|
subroutine where_allocatable_assignments(a, b)
|
|
integer :: a(:)
|
|
integer, allocatable :: b(:)
|
|
where(b > 0)
|
|
b = a
|
|
elsewhere
|
|
b(:) = 0
|
|
end where
|
|
end subroutine
|
|
! TODO: broken: passing allocation through fir.result
|
|
! CHECK: func.func
|
|
! CHECK-SAME: where_allocatable_assignments
|
|
! CHECK: return
|
|
! CHECK-NEXT: }
|
|
|
|
subroutine array_constructor(a, b)
|
|
real :: a(5), b
|
|
real, external :: f
|
|
a = [f(b), f(b+1), f(b+2), f(b+5), f(b+11)]
|
|
end subroutine
|
|
! TODO: broken: realloc
|
|
! CHECK: func.func
|
|
! CHECK-SAME: array_constructor
|
|
! CHECK: return
|
|
! CHECK-NEXT: }
|
|
|
|
subroutine sequence(seq, n)
|
|
integer :: n, seq(n)
|
|
seq = [(i,i=1,n)]
|
|
end subroutine
|
|
! TODO: broken: realloc
|
|
! CHECK: func.func
|
|
! CHECK-SAME: sequence
|
|
! CHECK: return
|
|
! CHECK-NEXT: }
|
|
|
|
subroutine CFGLoop(x)
|
|
integer, parameter :: k = 100, m=1000000, n = k*m
|
|
integer :: x(n)
|
|
logical :: has_error
|
|
|
|
do i=0,m-1
|
|
x(k*i+1:k*(i+1)) = x(k*(i+1):k*i+1:-1)
|
|
if (has_error(x, k)) stop
|
|
end do
|
|
end subroutine
|
|
! CHECK: func.func
|
|
! CHECK-SAME: cfgloop
|
|
! CHECK-NEXT: %[[MEM:.*]] = fir.alloca !fir.array<100000000xi32>
|
|
! CHECK-NOT: fir.allocmem
|
|
! CHECK-NOT: fir.freemem
|
|
! CHECK: return
|
|
! CHECK-NEXT: }
|