blob: 91977ff1d35ec4acab9c35349943b8f39e63c519 (
plain)
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
|
! { dg-do run }
program ptr_comp
type t
integer, pointer :: z(:)
end type
type(t), save :: obj[*]
integer, allocatable, target :: i(:)[:]
if (associated(obj%z)) error stop "'z' should not be associated yet."
allocate (obj%z(5))
call f(obj)
if (associated(obj%z)) error stop "'z' should not be associated anymore."
allocate(i(7)[*], SOURCE=42)
obj%z => i
if (.not. allocated(i)) error stop "'i' no longer allocated."
i = 15
if (any(obj%z(:) /= 15)) error stop "'obj%z' is deep copy and not pointer."
nullify (obj%z)
if (.not. allocated(i)) error stop "'i' should still be allocated."
if (associated(obj%z)) error stop "'obj%z' should not be associated anymore."
obj%z => i
call f(obj)
! One can not say anything about i here. The memory should be deallocated, but
! the pointer in i is still set.
if (associated(obj%z)) error stop "'obj%z' should not be associated anymore."
contains
subroutine f(x)
type(t) :: x[*]
if ( associated(x%z) ) deallocate(x%z)
end subroutine
end program
|
