1! { dg-do compile }
2! { dg-options "-std=f2003 -fall-intrinsics" }
3! { dg-shouldfail "Invalid code" }
4!
5! Pointer intent test
6! PR fortran/29624
7!
8! Valid program
9program test
10 implicit none
11 type myT
12    integer :: j = 5
13    integer, pointer :: jp => null()
14 end type myT
15 integer, pointer :: p
16 type(myT) :: t
17 call a(p)
18 call b(t)
19contains
20  subroutine a(p)
21    integer, pointer,intent(in) :: p
22    p => null(p)! { dg-error "pointer association context" }
23    nullify(p)  ! { dg-error "pointer association context" }
24    allocate(p) ! { dg-error "pointer association context" }
25    call c(p)   ! { dg-error "pointer association context" }
26    deallocate(p) ! { dg-error "pointer association context" }
27  end subroutine
28  subroutine c(p)
29    integer, pointer, intent(inout) :: p
30    nullify(p)
31  end subroutine c
32  subroutine b(t)
33    type(myT),intent(in) :: t
34    t%jp = 5
35    t%jp => null(t%jp)  ! { dg-error "pointer association context" }
36    nullify(t%jp) ! { dg-error "pointer association context" }
37    t%j = 7 ! { dg-error "variable definition context" }
38    allocate(t%jp) ! { dg-error "pointer association context" }
39    deallocate(t%jp) ! { dg-error "pointer association context" }
40  end subroutine b
41end program
42