1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
! { 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" } }
|
