! { dg-do run } ! ! Tests functionality of recursive allocatable derived types. ! type :: recurses type(recurses), allocatable :: c integer, allocatable :: ia end type type(recurses), allocatable, target :: a, d type(recurses), pointer :: b integer :: total = 0 ! Check chained allocation. allocate(a) a%ia = 1 allocate (a%c) a%c%ia = 2 ! Check move_alloc. allocate (d) d%ia = 3 call move_alloc (d, a%c%c) if (a%ia .ne. 1) STOP 1 if (a%c%ia .ne. 2) STOP 2 if (a%c%c%ia .ne. 3) STOP 3 ! Check that we can point anywhere in the chain b => a%c%c if (b%ia .ne. 3) STOP 4 b => a%c if (b%ia .ne. 2) STOP 5 ! Check that the pointer can be used as if it were an element in the chain. if (.not.allocated (b%c)) STOP 6 b => a%c%c if (.not.allocated (b%c)) allocate (b%c) b%c%ia = 4 if (a%c%c%c%ia .ne. 4) STOP 7 ! A rudimentary iterator. b => a do while (associated (b)) total = total + b%ia b => b%c end do if (total .ne. 10) STOP 8 ! Take one element out of the chain. call move_alloc (a%c%c, d) call move_alloc (d%c, a%c%c) if (d%ia .ne. 3) STOP 9 deallocate (d) ! Checkcount of remaining chain. total = 0 b => a do while (associated (b)) total = total + b%ia b => b%c end do if (total .ne. 7) STOP 10 ! Deallocate to check that there are no memory leaks. deallocate (a%c%c) deallocate (a%c) deallocate (a) end