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
|
! { dg-do run }
!
! Tests functionality of recursive allocatable derived types.
!
module m
type :: recurses
type(recurses), allocatable :: left
type(recurses), allocatable :: right
integer, allocatable :: ia
end type
contains
! Obtain checksum from "keys".
recursive function foo (this) result (res)
type(recurses) :: this
integer :: res
res = this%ia
if (allocated (this%left)) res = res + foo (this%left)
if (allocated (this%right)) res = res + foo (this%right)
end function
! Return pointer to member of binary tree matching "key", null otherwise.
recursive function bar (this, key) result (res)
type(recurses), target :: this
type(recurses), pointer :: res
integer :: key
if (key .eq. this%ia) then
res => this
return
else
res => NULL ()
end if
if (allocated (this%left)) res => bar (this%left, key)
if (associated (res)) return
if (allocated (this%right)) res => bar (this%right, key)
end function
end module
use m
type(recurses), allocatable, target :: a
type(recurses), pointer :: b => NULL ()
! Check chained allocation.
allocate(a)
a%ia = 1
allocate (a%left)
a%left%ia = 2
allocate (a%left%left)
a%left%left%ia = 3
allocate (a%left%right)
a%left%right%ia = 4
allocate (a%right)
a%right%ia = 5
! Checksum OK?
if (foo(a) .ne. 15) STOP 1
! Return pointer to tree item that is present.
b => bar (a, 3)
if (.not.associated (b) .or. (b%ia .ne. 3)) STOP 2
! Return NULL to tree item that is not present.
b => bar (a, 6)
if (associated (b)) STOP 3
! Deallocate to check that there are no memory leaks.
deallocate (a)
end
|
