fix pr/45972
[official-gcc.git] / gcc / testsuite / gfortran.dg / pointer_intent_1.f90
blob1bdab241c18720e184f99fae6e247fd77f1ec801
1 ! { dg-do run }
2 ! { dg-options "-std=f2003 -fall-intrinsics" }
3 ! Pointer intent test
4 ! PR fortran/29624
6 ! Valid program
7 program 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) call abort()
29 contains
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) call abort()
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)) call abort()
42 if(t%point /= 55) call abort()
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) call abort()
52 if(t%x /= -15) call abort()
53 call foo(t)
54 if(t%x /= 32) call abort()
55 if(t%point /= -98) call abort()
56 end if
57 call b(p)
58 if(p /= 5) call abort()
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) call abort()
67 if(comp%point /= 27) call abort()
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 ) call abort()
74 if(t%point /= 42) call abort()
75 t%point = 7
76 end subroutine nonpointer
77 end program