1! { dg-do run } 2! 3! Tests functionality of recursive allocatable derived types. 4! Here the recursive components are arrays, unlike the first three testcases. 5! Notice that array components are fiendishly difficult to use :-( 6! 7module m 8 type :: recurses 9 type(recurses), allocatable :: c(:) 10 integer, allocatable :: ia 11 end type 12end module 13 14 use m 15 type(recurses), allocatable, target :: a, d(:) 16 type(recurses), pointer :: b1 17 18 integer :: total = 0 19 20! Check chained allocation. 21 allocate(a) 22 a%ia = 1 23 allocate (a%c(2)) 24 b1 => a%c(1) 25 b1%ia = 2 26 27! Check move_alloc. 28 allocate (d(2)) 29 d(1)%ia = 3 30 d(2)%ia = 4 31 b1 => d(2) 32 allocate (b1%c(1)) 33 b1 => b1%c(1) 34 b1%ia = 5 35 call move_alloc (d, a%c(2)%c) 36 37 if (a%ia .ne. 1) STOP 1 38 if (a%c(1)%ia .ne. 2) STOP 2 39 if (a%c(2)%c(1)%ia .ne. 3) STOP 3 40 if (a%c(2)%c(2)%ia .ne. 4) STOP 4 41 if (a%c(2)%c(2)%c(1)%ia .ne. 5) STOP 5 42 43 if (allocated (a)) deallocate (a) 44 if (allocated (d)) deallocate (d) 45 46end 47