From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001
From: upstream source tree <ports@midipix.org>
Date: Sun, 15 Mar 2015 20:14:05 -0400
Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; 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.
---
 .../gfortran.dg/allocatable_function_1.f90         | 112 +++++++++++++++++++++
 1 file changed, 112 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/allocatable_function_1.f90

(limited to 'gcc/testsuite/gfortran.dg/allocatable_function_1.f90')

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" } }
-- 
cgit v1.2.3