Subversion Repositories openrisc_me

! { 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