113 lines
2.8 KiB
Fortran
113 lines
2.8 KiB
Fortran
! { dg-do run }
|
|
! { dg-options "-O2 -fdump-tree-original" }
|
|
! Test ALLOCATABLE functions; the primary purpose here is to check that
|
|
! each of the various types of reference result in the function result
|
|
! being deallocated, using _gfortran_internal_free.
|
|
! The companion, allocatable_function_1r.f90, executes this program.
|
|
!
|
|
subroutine moobar (a)
|
|
integer, intent(in) :: a(:)
|
|
|
|
if (.not.all(a == [ 1, 2, 3 ])) call abort()
|
|
end subroutine moobar
|
|
|
|
function foo2 (n)
|
|
integer, intent(in) :: n
|
|
integer, allocatable :: foo2(:)
|
|
integer :: i
|
|
allocate (foo2(n))
|
|
do i = 1, n
|
|
foo2(i) = i
|
|
end do
|
|
end function foo2
|
|
|
|
module m
|
|
contains
|
|
function foo3 (n)
|
|
integer, intent(in) :: n
|
|
integer, allocatable :: foo3(:)
|
|
integer :: i
|
|
allocate (foo3(n))
|
|
do i = 1, n
|
|
foo3(i) = i
|
|
end do
|
|
end function foo3
|
|
end module m
|
|
|
|
program alloc_fun
|
|
|
|
use m
|
|
implicit none
|
|
|
|
integer :: a(3)
|
|
|
|
interface
|
|
subroutine moobar (a)
|
|
integer, intent(in) :: a(:)
|
|
end subroutine moobar
|
|
end interface
|
|
|
|
interface
|
|
function foo2 (n)
|
|
integer, intent(in) :: n
|
|
integer, allocatable :: foo2(:)
|
|
end function foo2
|
|
end interface
|
|
|
|
! 2 _gfortran_internal_free's
|
|
if (.not.all(foo1(3) == [ 1, 2, 3 ])) call abort()
|
|
a = foo1(size(a))
|
|
|
|
! 1 _gfortran_internal_free
|
|
if (.not.all(a == [ 1, 2, 3 ])) call abort()
|
|
call foobar(foo1(3))
|
|
|
|
! 1 _gfortran_internal_free
|
|
if (.not.all(2*bar(size(a)) + 5 == [ 7, 9, 11 ])) call abort()
|
|
|
|
! Although the rhs determines the loop size, the lhs reference is
|
|
! evaluated, in case it has side-effects or is needed for bounds checking.
|
|
! 3 _gfortran_internal_free's
|
|
a(1:size (bar (3))) = 2*bar(size(a)) + 2 + a(size (bar (3)))
|
|
if (.not.all(a == [ 7, 9, 11 ])) call abort()
|
|
|
|
! 3 _gfortran_internal_free's
|
|
call moobar(foo1(3)) ! internal function
|
|
call moobar(foo2(3)) ! module function
|
|
call moobar(foo3(3)) ! explicit interface
|
|
|
|
! 9 _gfortran_internal_free's in total
|
|
contains
|
|
|
|
subroutine foobar (a)
|
|
integer, intent(in) :: a(:)
|
|
|
|
if (.not.all(a == [ 1, 2, 3 ])) call abort()
|
|
end subroutine foobar
|
|
|
|
function foo1 (n)
|
|
integer, intent(in) :: n
|
|
integer, allocatable :: foo1(:)
|
|
integer :: i
|
|
allocate (foo1(n))
|
|
do i = 1, n
|
|
foo1(i) = i
|
|
end do
|
|
end function foo1
|
|
|
|
function bar (n) result(b)
|
|
integer, intent(in) :: n
|
|
integer, target, allocatable :: b(:)
|
|
integer :: i
|
|
|
|
allocate (b(n))
|
|
do i = 1, n
|
|
b(i) = i
|
|
end do
|
|
end function bar
|
|
|
|
end program alloc_fun
|
|
! { dg-final { scan-tree-dump-times "free" 10 "original" } }
|
|
! { dg-final { cleanup-tree-dump "original" } }
|
|
! { dg-final { cleanup-modules "m" } }
|