URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [allocatable_function_1.f90] - Rev 302
Go to most recent revision | Compare with Previous | Blame | View Log
! { 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" } }
Go to most recent revision | Compare with Previous | Blame | View Log