1! { dg-do run }
2! { dg-options "-O2 -fdump-tree-original" }
3! Test ALLOCATABLE functions; the primary purpose here is to check that
4! each of the various types of reference result in the function result
5! being deallocated, using _gfortran_internal_free.
6! The companion, allocatable_function_1r.f90, executes this program.
7!
8subroutine moobar (a)
9    integer, intent(in) :: a(:)
10
11    if (.not.all(a == [ 1, 2, 3 ])) STOP 1
12end subroutine moobar
13
14function foo2 (n)
15    integer, intent(in) :: n
16    integer, allocatable :: foo2(:)
17    integer :: i
18    allocate (foo2(n))
19    do i = 1, n
20        foo2(i) = i
21    end do
22end function foo2
23
24module m
25contains
26    function foo3 (n)
27        integer, intent(in) :: n
28        integer, allocatable :: foo3(:)
29        integer :: i
30        allocate (foo3(n))
31        do i = 1, n
32            foo3(i) = i
33        end do
34    end function foo3
35end module m
36
37program alloc_fun
38
39    use m
40    implicit none
41
42    integer :: a(3)
43
44    interface
45      subroutine moobar (a)
46          integer, intent(in) :: a(:)
47      end subroutine moobar
48    end interface
49
50    interface
51        function foo2 (n)
52            integer, intent(in) :: n
53            integer, allocatable :: foo2(:)
54        end function foo2
55    end interface
56
57! 2 _gfortran_internal_free's
58    if (.not.all(foo1(3) == [ 1, 2, 3 ])) STOP 2
59    a = foo1(size(a))
60
61! 1 _gfortran_internal_free
62    if (.not.all(a == [ 1, 2, 3 ])) STOP 3
63    call foobar(foo1(3))
64
65! 1 _gfortran_internal_free
66    if (.not.all(2*bar(size(a)) + 5 == [ 7, 9, 11 ])) STOP 4
67
68! Although the rhs determines the loop size, the lhs reference is
69! evaluated, in case it has side-effects or is needed for bounds checking.
70! 3 _gfortran_internal_free's
71    a(1:size (bar (3))) = 2*bar(size(a)) + 2 + a(size (bar (3)))
72    if (.not.all(a == [ 7, 9, 11 ])) STOP 5
73
74! 3 _gfortran_internal_free's
75    call moobar(foo1(3))   ! internal function
76    call moobar(foo2(3))   ! module function
77    call moobar(foo3(3))   ! explicit interface
78
79! 9 _gfortran_internal_free's in total
80contains
81
82    subroutine foobar (a)
83        integer, intent(in) :: a(:)
84
85        if (.not.all(a == [ 1, 2, 3 ])) STOP 6
86    end subroutine foobar
87
88    function foo1 (n)
89        integer, intent(in) :: n
90        integer, allocatable :: foo1(:)
91        integer :: i
92        allocate (foo1(n))
93        do i = 1, n
94            foo1(i) = i
95        end do
96    end function foo1
97
98    function bar (n) result(b)
99        integer, intent(in) :: n
100        integer, target, allocatable :: b(:)
101        integer :: i
102
103        allocate (b(n))
104        do i = 1, n
105            b(i) = i
106        end do
107    end function bar
108
109end program alloc_fun
110! { dg-final { scan-tree-dump-times "free" 10 "original" } }
111