1! { dg-do run } 2! 3! Tests functionality of recursive allocatable derived types. 4! 5 type :: recurses 6 type(recurses), allocatable :: c 7 integer, allocatable :: ia 8 end type 9 10 type(recurses), allocatable, target :: a, d 11 type(recurses), pointer :: b 12 13 integer :: total = 0 14 15! Check chained allocation. 16 allocate(a) 17 a%ia = 1 18 allocate (a%c) 19 a%c%ia = 2 20 21! Check move_alloc. 22 allocate (d) 23 d%ia = 3 24 call move_alloc (d, a%c%c) 25 26 if (a%ia .ne. 1) STOP 1 27 if (a%c%ia .ne. 2) STOP 2 28 if (a%c%c%ia .ne. 3) STOP 3 29 30! Check that we can point anywhere in the chain 31 b => a%c%c 32 if (b%ia .ne. 3) STOP 4 33 b => a%c 34 if (b%ia .ne. 2) STOP 5 35 36! Check that the pointer can be used as if it were an element in the chain. 37 if (.not.allocated (b%c)) STOP 6 38 b => a%c%c 39 if (.not.allocated (b%c)) allocate (b%c) 40 b%c%ia = 4 41 if (a%c%c%c%ia .ne. 4) STOP 7 42 43! A rudimentary iterator. 44 b => a 45 do while (associated (b)) 46 total = total + b%ia 47 b => b%c 48 end do 49 if (total .ne. 10) STOP 8 50 51! Take one element out of the chain. 52 call move_alloc (a%c%c, d) 53 call move_alloc (d%c, a%c%c) 54 if (d%ia .ne. 3) STOP 9 55 deallocate (d) 56 57! Checkcount of remaining chain. 58 total = 0 59 b => a 60 do while (associated (b)) 61 total = total + b%ia 62 b => b%c 63 end do 64 if (total .ne. 7) STOP 10 65 66! Deallocate to check that there are no memory leaks. 67 deallocate (a%c%c) 68 deallocate (a%c) 69 deallocate (a) 70end 71