1! { dg-do run } 2! 3! Tests functionality of recursive allocatable derived types. 4! 5module m 6 type :: recurses 7 type(recurses), allocatable :: left 8 type(recurses), allocatable :: right 9 integer, allocatable :: ia 10 end type 11contains 12! Obtain checksum from "keys". 13 recursive function foo (this) result (res) 14 type(recurses) :: this 15 integer :: res 16 res = this%ia 17 if (allocated (this%left)) res = res + foo (this%left) 18 if (allocated (this%right)) res = res + foo (this%right) 19 end function 20! Return pointer to member of binary tree matching "key", null otherwise. 21 recursive function bar (this, key) result (res) 22 type(recurses), target :: this 23 type(recurses), pointer :: res 24 integer :: key 25 if (key .eq. this%ia) then 26 res => this 27 return 28 else 29 res => NULL () 30 end if 31 if (allocated (this%left)) res => bar (this%left, key) 32 if (associated (res)) return 33 if (allocated (this%right)) res => bar (this%right, key) 34 end function 35end module 36 37 use m 38 type(recurses), allocatable, target :: a 39 type(recurses), pointer :: b => NULL () 40 41! Check chained allocation. 42 allocate(a) 43 a%ia = 1 44 allocate (a%left) 45 a%left%ia = 2 46 allocate (a%left%left) 47 a%left%left%ia = 3 48 allocate (a%left%right) 49 a%left%right%ia = 4 50 allocate (a%right) 51 a%right%ia = 5 52 53! Checksum OK? 54 if (foo(a) .ne. 15) STOP 1 55 56! Return pointer to tree item that is present. 57 b => bar (a, 3) 58 if (.not.associated (b) .or. (b%ia .ne. 3)) STOP 2 59! Return NULL to tree item that is not present. 60 b => bar (a, 6) 61 if (associated (b)) STOP 3 62 63! Deallocate to check that there are no memory leaks. 64 deallocate (a) 65end 66