2008-07-06 Kai Tietz <kai.tietz@onevision.com>
[official-gcc.git] / gcc / testsuite / gfortran.dg / allocatable_dummy_1.f90
blob9aba8b8fc6dc10791df56475ad4fc269d612ce04
1 ! { dg-do run }
2 ! Test procedures with allocatable dummy arguments
3 program alloc_dummy
5 implicit none
6 integer, allocatable :: a(:)
7 integer, allocatable :: b(:)
9 call init(a)
10 if (.NOT.allocated(a)) call abort()
11 if (.NOT.all(a == [ 1, 2, 3 ])) call abort()
13 call useit(a, b)
14 if (.NOT.all(b == [ 1, 2, 3 ])) call abort()
16 if (.NOT.all(whatever(a) == [ 1, 2, 3 ])) call abort()
18 call kill(a)
19 if (allocated(a)) call abort()
21 call kill(b)
22 if (allocated(b)) call abort()
24 contains
26 subroutine init(x)
27 integer, allocatable, intent(out) :: x(:)
28 allocate(x(3))
29 x = [ 1, 2, 3 ]
30 end subroutine init
32 subroutine useit(x, y)
33 integer, allocatable, intent(in) :: x(:)
34 integer, allocatable, intent(out) :: y(:)
35 if (allocated(y)) call abort()
36 call init(y)
37 y = x
38 end subroutine useit
40 function whatever(x)
41 integer, allocatable :: x(:)
42 integer :: whatever(size(x))
44 whatever = x
45 end function whatever
47 subroutine kill(x)
48 integer, allocatable, intent(out) :: x(:)
49 end subroutine kill
51 end program alloc_dummy