From 18eaa2c0cd2038ee3c4d83bf925ec0c65092d3de Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Mon, 10 Sep 2007 07:54:17 +0000 Subject: [PATCH] re PR fortran/33370 (Structure component arrays) 2007-09-10 Paul Thomas 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 PR fortran/33370 * gfortran.dg/array_memcpy_5.f90: New test. From-SVN: r128325 --- gcc/fortran/ChangeLog | 9 +++++++ gcc/fortran/trans-expr.c | 26 +++++++++----------- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/array_memcpy_5.f90 | 22 +++++++++++++++++ 4 files changed, 47 insertions(+), 15 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/array_memcpy_5.f90 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 + + 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 * 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 + + PR fortran/33370 + * gfortran.dg/array_memcpy_5.f90: New test. + 2007-09-10 Hans-Peter Nilsson * 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 +! +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 -- 2.30.2