summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/allocatable_function_1.f90
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/allocatable_function_1.f90
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.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.f90112
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" } }