blob: fe70e63c32f034e3a1291c14cd010cf0d96ec44e (
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 alloc_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)
call f(obj)
if (associated(obj%z)) error stop "'z' should not be associated anymore."
allocate(i[*], SOURCE=42)
obj%z => i
if (.not. allocated(i)) error stop "'i' no longer allocated."
i = 15
if (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
|
