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