diff options
author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
---|---|---|
committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/allocatable_function_1.f90 | |
download | cbb-gcc-4.6.4-upstream.tar.bz2 cbb-gcc-4.6.4-upstream.tar.xz |
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.
downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.
if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/gfortran.dg/allocatable_function_1.f90')
-rw-r--r-- | gcc/testsuite/gfortran.dg/allocatable_function_1.f90 | 112 |
1 files changed, 112 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/allocatable_function_1.f90 b/gcc/testsuite/gfortran.dg/allocatable_function_1.f90 new file mode 100644 index 000000000..fc3b983ad --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocatable_function_1.f90 @@ -0,0 +1,112 @@ +! { 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" } } |