+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.
}
-/* 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. */
}
/* 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);
}
/* 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))
{
}
/* 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))
{
--- /dev/null
+! { 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