Initial checkin of GCC 4.9.0 from trunk (r208799).

Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba

1 files changed, 57 insertions, 0 deletions

diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/alloc_comp_assign_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/alloc_comp_assign_1.f90
new file mode 100644
index 000000000..9d87af2f8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/alloc_comp_assign_1.f90
@@ -0,0 +1,57 @@
+! { dg-do run }
+! Test assignments of derived type with allocatable components (PR 20541).
+!
+! Contributed by Erik Edelmann  <eedelmann@gcc.gnu.org>
+!            and Paul Thomas  <pault@gcc.gnu.org>
+!
+  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