Commit 18eaa2c0 by Paul Thomas

re PR fortran/33370 (Structure component arrays)

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.

From-SVN: r128325
parent a5828d1e
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> 2007-09-06 Tom Tromey <tromey@redhat.com>
* scanner.c (get_file): Update. * scanner.c (get_file): Update.
......
...@@ -4062,13 +4062,19 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag) ...@@ -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 static bool
copyable_array_p (gfc_expr * expr) copyable_array_p (gfc_expr * expr)
{ {
if (expr->expr_type != EXPR_VARIABLE)
return false;
/* First check it's an array. */ /* 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; return false;
/* Next check that it's of a simple enough type. */ /* 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) ...@@ -4109,11 +4115,7 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
} }
/* Special case assigning an array to zero. */ /* Special case assigning an array to zero. */
if (expr1->expr_type == EXPR_VARIABLE if (copyable_array_p (expr1)
&& expr1->rank > 0
&& expr1->ref
&& expr1->ref->next == NULL
&& gfc_full_array_ref_p (expr1->ref)
&& is_zero_initializer_p (expr2)) && is_zero_initializer_p (expr2))
{ {
tmp = gfc_trans_zero_assign (expr1); tmp = gfc_trans_zero_assign (expr1);
...@@ -4122,12 +4124,8 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag) ...@@ -4122,12 +4124,8 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
} }
/* Special case copying one array to another. */ /* Special case copying one array to another. */
if (expr1->expr_type == EXPR_VARIABLE if (copyable_array_p (expr1)
&& copyable_array_p (expr1)
&& gfc_full_array_ref_p (expr1->ref)
&& expr2->expr_type == EXPR_VARIABLE
&& copyable_array_p (expr2) && copyable_array_p (expr2)
&& gfc_full_array_ref_p (expr2->ref)
&& gfc_compare_types (&expr1->ts, &expr2->ts) && gfc_compare_types (&expr1->ts, &expr2->ts)
&& !gfc_check_dependency (expr1, expr2, 0)) && !gfc_check_dependency (expr1, expr2, 0))
{ {
...@@ -4137,9 +4135,7 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag) ...@@ -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. */ /* Special case initializing an array from a constant array constructor. */
if (expr1->expr_type == EXPR_VARIABLE if (copyable_array_p (expr1)
&& copyable_array_p (expr1)
&& gfc_full_array_ref_p (expr1->ref)
&& expr2->expr_type == EXPR_ARRAY && expr2->expr_type == EXPR_ARRAY
&& gfc_compare_types (&expr1->ts, &expr2->ts)) && gfc_compare_types (&expr1->ts, &expr2->ts))
{ {
......
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> 2007-09-10 Hans-Peter Nilsson <hp@axis.com>
* gcc.dg/tree-ssa/ssa-fre-4.c: Skip for cris-*-* and mmix-*-*. * gcc.dg/tree-ssa/ssa-fre-4.c: Skip for cris-*-* and mmix-*-*.
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment