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