]>
Commit | Line | Data |
---|---|---|
8e119f1b EE |
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 | ! | |
8 | subroutine moobar (a) | |
9 | integer, intent(in) :: a(:) | |
10 | ||
11 | if (.not.all(a == [ 1, 2, 3 ])) call abort() | |
12 | end subroutine moobar | |
13 | ||
14 | function 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 | |
22 | end function foo2 | |
23 | ||
24 | module m | |
25 | contains | |
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 | |
35 | end module m | |
36 | ||
37 | program 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 ])) call abort() | |
59 | a = foo1(size(a)) | |
60 | ||
61 | ! 1 _gfortran_internal_free | |
62 | if (.not.all(a == [ 1, 2, 3 ])) call abort() | |
63 | call foobar(foo1(3)) | |
64 | ||
65 | ! 1 _gfortran_internal_free | |
66 | if (.not.all(2*bar(size(a)) + 5 == [ 7, 9, 11 ])) call abort() | |
67 | ||
8424e0d8 PT |
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 | |
8e119f1b EE |
71 | a(1:size (bar (3))) = 2*bar(size(a)) + 2 + a(size (bar (3))) |
72 | if (.not.all(a == [ 7, 9, 11 ])) call abort() | |
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 | |
80 | contains | |
81 | ||
82 | subroutine foobar (a) | |
83 | integer, intent(in) :: a(:) | |
84 | ||
85 | if (.not.all(a == [ 1, 2, 3 ])) call abort() | |
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 | ||
109 | end program alloc_fun | |
8424e0d8 | 110 | ! { dg-final { scan-tree-dump-times "free" 10 "original" } } |
8e119f1b | 111 | ! { dg-final { cleanup-tree-dump "original" } } |
b09940e9 | 112 | ! { dg-final { cleanup-modules "m" } } |