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