1! { dg-do run } 2! Test assignments of derived type with allocatable components (PR 20541). 3! 4! Contributed by Erik Edelmann <eedelmann@gcc.gnu.org> 5! and Paul Thomas <pault@gcc.gnu.org> 6! 7 type :: ivs 8 character(1), allocatable :: chars(:) 9 end type ivs 10 11 type(ivs) :: a, b 12 type(ivs) :: x(3), y(3) 13 14 allocate(a%chars(5)) 15 a%chars = (/"h","e","l","l","o"/) 16 17! An intrinsic assignment must deallocate the l-value and copy across 18! the array from the r-value. 19 b = a 20 if (any (b%chars .ne. (/"h","e","l","l","o"/))) call abort () 21 if (allocated (a%chars) .eqv. .false.) call abort () 22 23! Scalar to array needs to copy the derived type, to its ultimate components, 24! to each of the l-value elements. */ 25 x = b 26 x(2)%chars = (/"g","'","d","a","y"/) 27 if (any (x(1)%chars .ne. (/"h","e","l","l","o"/))) call abort () 28 if (any (x(2)%chars .ne. (/"g","'","d","a","y"/))) call abort () 29 if (allocated (b%chars) .eqv. .false.) call abort () 30 deallocate (x(1)%chars, x(2)%chars, x(3)%chars) 31 32! Array intrinsic assignments are like their scalar counterpart and 33! must deallocate each element of the l-value and copy across the 34! arrays from the r-value elements. 35 allocate(x(1)%chars(5), x(2)%chars(5), x(3)%chars(5)) 36 x(1)%chars = (/"h","e","l","l","o"/) 37 x(2)%chars = (/"g","'","d","a","y"/) 38 x(3)%chars = (/"g","o","d","a","g"/) 39 y(2:1:-1) = x(1:2) 40 if (any (y(1)%chars .ne. (/"g","'","d","a","y"/))) call abort () 41 if (any (y(2)%chars .ne. (/"h","e","l","l","o"/))) call abort () 42 if (any (x(3)%chars .ne. (/"g","o","d","a","g"/))) call abort () 43 44! In the case of an assignment where there is a dependency, so that a 45! temporary is necessary, each element must be copied to its 46! destination after it has been deallocated. 47 y(2:3) = y(1:2) 48 if (any (y(1)%chars .ne. (/"g","'","d","a","y"/))) call abort () 49 if (any (y(2)%chars .ne. (/"g","'","d","a","y"/))) call abort () 50 if (any (y(3)%chars .ne. (/"h","e","l","l","o"/))) call abort () 51 52! An identity assignment must not do any deallocation....! 53 y = y 54 if (any (y(1)%chars .ne. (/"g","'","d","a","y"/))) call abort () 55 if (any (y(2)%chars .ne. (/"g","'","d","a","y"/))) call abort () 56 if (any (y(3)%chars .ne. (/"h","e","l","l","o"/))) call abort () 57end 58