2 ! Test assignments of derived type with allocatable components (PR 20541).
4 ! Contributed by Erik Edelmann <eedelmann@gcc.gnu.org>
5 ! and Paul Thomas <pault@gcc.gnu.org>
8 character(1), allocatable :: chars(:)
12 type(ivs) :: x(3), y(3)
15 a%chars = (/"h","e","l","l","o"/)
17 ! An intrinsic assignment must deallocate the l-value and copy across
18 ! the array from the r-value.
20 if (any (b%chars .ne. (/"h","e","l","l","o"/))) call abort ()
21 if (allocated (a%chars) .eqv. .false.) call abort ()
23 ! Scalar to array needs to copy the derived type, to its ultimate components,
24 ! to each of the l-value elements. */
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)
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"/)
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 ()
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.
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 ()
52 ! An identity assignment must not do any deallocation....!
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 ()