summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/allocatable_function_1.f90
blob: fc3b983ad1d43e5b629ab222f4d4935c14545b46 (plain)
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
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" } }