OSDN Git Service

2010-11-15 Tobias Burnus <burnus@net.b.de>
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / allocatable_scalar_5.f90
1 ! { dg-do run }
2 ! { dg-options "-Wall -pedantic" }
3 !
4 ! PR fortran/41872; updated due to PR fortran/46484
5 !
6 !  More tests for allocatable scalars
7 !
8 program test
9   implicit none
10   integer, allocatable :: a
11   integer :: b
12
13   if (allocated (a)) call abort ()
14   b = 7
15   b = func(.true.)
16   if (b /= 5332) call abort () 
17   b = 7
18   b = func(.true.) + 1
19   if (b /= 5333) call abort () 
20    
21   call intout (a, .false.)
22   if (allocated (a)) call abort ()
23   call intout (a, .true.)
24   if (.not.allocated (a)) call abort ()
25   if (a /= 764) call abort ()
26   call intout2 (a)
27   if (allocated (a)) call abort ()
28
29 contains
30
31   function func (alloc)
32     integer, allocatable ::  func
33     logical :: alloc
34     if (allocated (func)) call abort ()
35     if (alloc) then
36       allocate(func)
37       func = 5332
38     end if
39   end function func
40
41   subroutine intout (dum, alloc)
42     implicit none
43     integer, allocatable,intent(out) :: dum
44     logical :: alloc
45     if (allocated (dum)) call abort()
46     if (alloc) then
47       allocate (dum)
48       dum = 764
49     end if
50   end subroutine intout
51
52   subroutine intout2 (dum) ! { dg-warning "declared INTENT.OUT. but was not set" }
53     integer, allocatable,intent(out) :: dum
54   end subroutine intout2
55 end program test