1! { dg-do run }
2! { dg-options "-std=f2003 " }
3! Pointer intent test
4! PR fortran/29624
5!
6! Valid program
7program test
8 implicit none
9 type myT
10   integer          :: x
11   integer, pointer :: point
12 end type myT
13 integer, pointer :: p
14 type(myT), pointer :: t
15 type(myT) :: t2
16 allocate(p,t)
17 allocate(t%point)
18 t%point = 55
19 p = 33
20 call a(p,t)
21 deallocate(p)
22 nullify(p)
23 call a(p,t)
24 t2%x     = 5
25 allocate(t2%point)
26 t2%point = 42
27 call nonpointer(t2)
28 if(t2%point /= 7) STOP 1
29contains
30  subroutine a(p,t)
31    integer, pointer,intent(in)    :: p
32    type(myT), pointer, intent(in) :: t
33    integer, pointer :: tmp
34    if(.not.associated(p)) return
35    if(p /= 33) STOP 2
36    p = 7
37    if (associated(t)) then
38      ! allocating is valid as we don't change the status
39      ! of the pointer "t", only of it's target
40      t%x = -15
41      if(.not.associated(t%point)) STOP 3
42      if(t%point /= 55) STOP 4
43      nullify(t%point)
44      allocate(tmp)
45      t%point => tmp
46      deallocate(t%point)
47      t%point => null(t%point)
48      tmp => null(tmp)
49      allocate(t%point)
50      t%point = 27
51      if(t%point /= 27) STOP 5
52      if(t%x     /= -15) STOP 6
53      call foo(t)
54      if(t%x     /=  32) STOP 7
55      if(t%point /= -98) STOP 8
56    end if
57    call b(p)
58    if(p /= 5) STOP 9
59  end subroutine
60  subroutine b(v)
61    integer, intent(out) :: v
62    v = 5
63  end subroutine b
64  subroutine foo(comp)
65    type(myT), intent(inout) :: comp
66    if(comp%x     /= -15) STOP 10
67    if(comp%point /=  27) STOP 11
68    comp%x     = 32
69    comp%point = -98
70  end subroutine foo
71  subroutine nonpointer(t)
72     type(myT), intent(in) :: t
73     if(t%x     /= 5 ) STOP 12
74     if(t%point /= 42) STOP 13
75     t%point = 7
76  end subroutine nonpointer
77end program
78