2007-09-10 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/33370
	* trans-expr.c (copyable_array_p):  Add tests that expression
	is a variable, that it has no subreferences and that it is a
	full array.
	(gfc_trans_assignment): Change conditions to suit modifications
	to copyable_array_p.

2007-09-10  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33370
	* gfortran.dg/array_memcpy_5.f90:  New test.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@128325 138bc75d-0d04-0410-961f-82ee72b054a4

4 files changed, 47 insertions, 15 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8c941246199..8157e00e7cd 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2007-09-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33370
+	* trans-expr.c (copyable_array_p):  Add tests that expression
+	is a variable, that it has no subreferences and that it is a
+	full array.
+	(gfc_trans_assignment): Change conditions to suit modifications
+	to copyable_array_p.
+
 2007-09-06  Tom Tromey  <tromey@redhat.com>
 
 	* scanner.c (get_file): Update.
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 99f180a1771..411109287ce 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4062,13 +4062,19 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
 }
 
 
-/* Check whether EXPR, which is an EXPR_VARIABLE, is a copyable array.  */
+/* Check whether EXPR is a copyable array.  */
 
 static bool
 copyable_array_p (gfc_expr * expr)
 {
+  if (expr->expr_type != EXPR_VARIABLE)
+    return false;
+
   /* First check it's an array.  */
-  if (expr->rank < 1 || !expr->ref)
+  if (expr->rank < 1 || !expr->ref || expr->ref->next)
+    return false;
+
+  if (!gfc_full_array_ref_p (expr->ref))
     return false;
 
   /* Next check that it's of a simple enough type.  */
@@ -4109,11 +4115,7 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
     }
 
   /* Special case assigning an array to zero.  */
-  if (expr1->expr_type == EXPR_VARIABLE
-      && expr1->rank > 0
-      && expr1->ref
-      && expr1->ref->next == NULL
-      && gfc_full_array_ref_p (expr1->ref)
+  if (copyable_array_p (expr1)
       && is_zero_initializer_p (expr2))
     {
       tmp = gfc_trans_zero_assign (expr1);
@@ -4122,12 +4124,8 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
     }
 
   /* Special case copying one array to another.  */
-  if (expr1->expr_type == EXPR_VARIABLE
-      && copyable_array_p (expr1)
-      && gfc_full_array_ref_p (expr1->ref)
-      && expr2->expr_type == EXPR_VARIABLE
+  if (copyable_array_p (expr1)
       && copyable_array_p (expr2)
-      && gfc_full_array_ref_p (expr2->ref)
       && gfc_compare_types (&expr1->ts, &expr2->ts)
       && !gfc_check_dependency (expr1, expr2, 0))
     {
@@ -4137,9 +4135,7 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
     }
 
   /* Special case initializing an array from a constant array constructor.  */
-  if (expr1->expr_type == EXPR_VARIABLE
-      && copyable_array_p (expr1)
-      && gfc_full_array_ref_p (expr1->ref)
+  if (copyable_array_p (expr1)
       && expr2->expr_type == EXPR_ARRAY
       && gfc_compare_types (&expr1->ts, &expr2->ts))
     {
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d69715e3ad1..bd7bde726a2 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-09-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33370
+	* gfortran.dg/array_memcpy_5.f90:  New test.
+
 2007-09-10  Hans-Peter Nilsson  <hp@axis.com>
 
 	* gcc.dg/tree-ssa/ssa-fre-4.c: Skip for cris-*-* and mmix-*-*.
diff --git a/gcc/testsuite/gfortran.dg/array_memcpy_5.f90 b/gcc/testsuite/gfortran.dg/array_memcpy_5.f90
new file mode 100644
index 00000000000..40fb6957a0d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_memcpy_5.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Tests the fix for PR33370, in which array copying, with subreferences
+! was broken due to a regression.
+!
+! Reported by Thomas Koenig <tkoenig@gcc.gnu.org>
+!
+program main
+  type foo
+    integer :: i
+     character(len=3) :: c
+  end type foo
+  type(foo), dimension(2) :: a = (/foo (1, "uvw"), foo (2, "xyz")/)
+  type(foo), dimension(2) :: b = (/foo (101, "abc"), foo (102, "def")/)
+  a%i = 0
+  print *, a
+  a%i = (/ 12, 2/)
+  if (any (a%c .ne. (/"uvw", "xyz"/))) call abort ()
+  if (any (a%i .ne. (/12, 2/))) call abort ()
+  a%i = b%i
+  if (any (a%c .ne. (/"uvw", "xyz"/))) call abort ()
+  if (any (a%i .ne. (/101, 102/))) call abort ()
+end program main