1! { dg-do compile }
2! PR fortran/32936
3!
4!
5function all_res()
6  implicit none
7  real, pointer :: gain
8  integer :: all_res
9  allocate (gain,STAT=all_res)
10  deallocate(gain)
11  call bar()
12contains
13  subroutine bar()
14    real, pointer :: gain2
15    allocate (gain2,STAT=all_res)
16    deallocate(gain2)
17  end subroutine bar
18end function all_res
19
20function func()
21  implicit none
22  real, pointer :: gain
23  integer :: all_res2, func
24  func = 0
25entry all_res2
26  allocate (gain,STAT=all_res2)
27  deallocate(gain)
28contains
29  subroutine test
30    implicit none
31    real, pointer :: gain2
32     allocate (gain2,STAT=all_res2)
33     deallocate(gain2)
34  end subroutine test
35end function func
36
37function func2() result(res)
38  implicit none
39  real, pointer :: gain
40  integer :: res
41  allocate (gain,STAT=func2) ! { dg-error "is not a variable" }
42  deallocate(gain)
43  res = 0
44end function func2
45
46subroutine sub()
47  implicit none
48  interface
49    integer function func2()
50    end function
51  end interface
52  real, pointer :: gain
53  integer, parameter :: res = 2
54  allocate (gain,STAT=func2) ! { dg-error "is not a variable" }
55  deallocate(gain)
56end subroutine sub
57
58module test
59contains
60 function one()
61   integer :: one, two
62   integer, pointer :: ptr
63   allocate(ptr, stat=one)
64   if(one == 0) deallocate(ptr)
65 entry two
66   allocate(ptr, stat=two)
67   if(associated(ptr)) deallocate(ptr)
68 end function one
69 subroutine sub()
70   integer, pointer :: p
71   allocate(p, stat=one) ! { dg-error "is not a variable" }
72   if(associated(p)) deallocate(p)
73   allocate(p, stat=two) ! { dg-error "is not a variable" }
74   if(associated(p)) deallocate(p)
75 end subroutine sub
76end module test
77