! { dg-do run } ! Test assignments of derived type with allocatable components (PR 20541). ! ! Contributed by Erik Edelmann ! and Paul Thomas ! type :: ivs character(1), allocatable :: chars(:) end type ivs type(ivs) :: a, b type(ivs) :: x(3), y(3) allocate(a%chars(5)) a%chars = (/"h","e","l","l","o"/) ! An intrinsic assignment must deallocate the l-value and copy across ! the array from the r-value. b = a if (any (b%chars .ne. (/"h","e","l","l","o"/))) call abort () if (allocated (a%chars) .eqv. .false.) call abort () ! Scalar to array needs to copy the derived type, to its ultimate components, ! to each of the l-value elements. */ x = b x(2)%chars = (/"g","'","d","a","y"/) if (any (x(1)%chars .ne. (/"h","e","l","l","o"/))) call abort () if (any (x(2)%chars .ne. (/"g","'","d","a","y"/))) call abort () if (allocated (b%chars) .eqv. .false.) call abort () deallocate (x(1)%chars, x(2)%chars, x(3)%chars) ! Array intrinsic assignments are like their scalar counterpart and ! must deallocate each element of the l-value and copy across the ! arrays from the r-value elements. allocate(x(1)%chars(5), x(2)%chars(5), x(3)%chars(5)) x(1)%chars = (/"h","e","l","l","o"/) x(2)%chars = (/"g","'","d","a","y"/) x(3)%chars = (/"g","o","d","a","g"/) y(2:1:-1) = x(1:2) if (any (y(1)%chars .ne. (/"g","'","d","a","y"/))) call abort () if (any (y(2)%chars .ne. (/"h","e","l","l","o"/))) call abort () if (any (x(3)%chars .ne. (/"g","o","d","a","g"/))) call abort () ! In the case of an assignment where there is a dependency, so that a ! temporary is necessary, each element must be copied to its ! destination after it has been deallocated. y(2:3) = y(1:2) if (any (y(1)%chars .ne. (/"g","'","d","a","y"/))) call abort () if (any (y(2)%chars .ne. (/"g","'","d","a","y"/))) call abort () if (any (y(3)%chars .ne. (/"h","e","l","l","o"/))) call abort () ! An identity assignment must not do any deallocation....! y = y if (any (y(1)%chars .ne. (/"g","'","d","a","y"/))) call abort () if (any (y(2)%chars .ne. (/"g","'","d","a","y"/))) call abort () if (any (y(3)%chars .ne. (/"h","e","l","l","o"/))) call abort () end