From 8d60cc468e8c1956cef570588d4297ce3a740328 Mon Sep 17 00:00:00 2001 From: pault Date: Mon, 29 Jun 2009 20:38:59 +0000 Subject: [PATCH] 2009-06-29 Paul Thomas PR fortran/40551 * dependency.h : Add second bool* argument to prototype of gfc_full_array_ref_p. * dependency.c (gfc_full_array_ref_p): If second argument is present, return true if last dimension of reference is an element or has unity stride. * trans-array.c : Add NULL second argument to references to gfc_full_array_ref_p. * trans-expr.c : The same, except for; (gfc_trans_arrayfunc_assign): Return fail if lhs reference is not a full array or a contiguous section. 2009-06-29 Paul Thomas PR fortran/40551 * gfortran.dg/func_assign_2.f90 : New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149062 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 14 ++++++++++++ gcc/fortran/dependency.c | 31 ++++++++++++++++++++------- gcc/fortran/dependency.h | 2 +- gcc/fortran/trans-array.c | 2 +- gcc/fortran/trans-expr.c | 7 +++++- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/func_assign_2.f90 | 33 +++++++++++++++++++++++++++++ 7 files changed, 83 insertions(+), 11 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/func_assign_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3357fde..976a448 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,17 @@ +2009-06-29 Paul Thomas + + PR fortran/40551 + * dependency.h : Add second bool* argument to prototype of + gfc_full_array_ref_p. + * dependency.c (gfc_full_array_ref_p): If second argument is + present, return true if last dimension of reference is an + element or has unity stride. + * trans-array.c : Add NULL second argument to references to + gfc_full_array_ref_p. + * trans-expr.c : The same, except for; + (gfc_trans_arrayfunc_assign): Return fail if lhs reference + is not a full array or a contiguous section. + 2009-06-28 Tobias Burnus Francois-Xavier Coudert diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index 5f74c34..eb07e7c 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.c @@ -1186,12 +1186,16 @@ gfc_check_element_vs_element (gfc_ref *lref, gfc_ref *rref, int n) /* Determine if an array ref, usually an array section specifies the - entire array. */ + entire array. In addition, if the second, pointer argument is + provided, the function will return true if the reference is + contiguous; eg. (:, 1) gives true but (1,:) gives false. */ bool -gfc_full_array_ref_p (gfc_ref *ref) +gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous) { int i; + bool lbound_OK = true; + bool ubound_OK = true; if (ref->type != REF_ARRAY) return false; @@ -1209,6 +1213,10 @@ gfc_full_array_ref_p (gfc_ref *ref) the correct element. */ if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT) { + /* This is a contiguous reference. */ + if (contiguous) + *contiguous = (i + 1 == ref->u.ar.dimen); + if (!ref->u.ar.as || !ref->u.ar.as->lower[i] || !ref->u.ar.as->upper[i] @@ -1228,17 +1236,24 @@ gfc_full_array_ref_p (gfc_ref *ref) || !ref->u.ar.as->lower[i] || gfc_dep_compare_expr (ref->u.ar.start[i], ref->u.ar.as->lower[i]))) - return false; + lbound_OK = false; /* Check the upper bound. */ if (ref->u.ar.end[i] && (!ref->u.ar.as || !ref->u.ar.as->upper[i] || gfc_dep_compare_expr (ref->u.ar.end[i], ref->u.ar.as->upper[i]))) - return false; + ubound_OK = false; /* Check the stride. */ if (ref->u.ar.stride[i] && !gfc_expr_is_one (ref->u.ar.stride[i], 0)) return false; + + /* This is a contiguous reference. */ + if (contiguous) + *contiguous = (i + 1 == ref->u.ar.dimen); + + if (!lbound_OK || !ubound_OK) + return false; } return true; } @@ -1356,11 +1371,11 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref) if (lref->u.ar.dimen != rref->u.ar.dimen) { if (lref->u.ar.type == AR_FULL) - fin_dep = gfc_full_array_ref_p (rref) ? GFC_DEP_EQUAL - : GFC_DEP_OVERLAP; + fin_dep = gfc_full_array_ref_p (rref, NULL) ? GFC_DEP_EQUAL + : GFC_DEP_OVERLAP; else if (rref->u.ar.type == AR_FULL) - fin_dep = gfc_full_array_ref_p (lref) ? GFC_DEP_EQUAL - : GFC_DEP_OVERLAP; + fin_dep = gfc_full_array_ref_p (lref, NULL) ? GFC_DEP_EQUAL + : GFC_DEP_OVERLAP; else return 1; break; diff --git a/gcc/fortran/dependency.h b/gcc/fortran/dependency.h index 1920c55..6fa0416 100644 --- a/gcc/fortran/dependency.h +++ b/gcc/fortran/dependency.h @@ -33,7 +33,7 @@ gfc_dep_check; /*********************** Functions prototypes **************************/ bool gfc_ref_needs_temporary_p (gfc_ref *); -bool gfc_full_array_ref_p (gfc_ref *); +bool gfc_full_array_ref_p (gfc_ref *, bool *); gfc_expr *gfc_get_noncopying_intrinsic_argument (gfc_expr *); int gfc_check_fncall_dependency (gfc_expr *, sym_intent, gfc_symbol *, gfc_actual_arglist *, gfc_dep_check); diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index cf38fc3..ce9114f 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5008,7 +5008,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) else if (se->direct_byref) full = 0; else - full = gfc_full_array_ref_p (info->ref); + full = gfc_full_array_ref_p (info->ref, NULL); if (full) { diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index f79ad4b..6a38f10 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -4300,6 +4300,7 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2) gfc_ss *ss; gfc_ref * ref; bool seen_array_ref; + bool c = false; gfc_component *comp = NULL; /* The caller has already checked rank>0 and expr_type == EXPR_FUNCTION. */ @@ -4311,6 +4312,10 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2) && expr2->value.function.esym->attr.elemental) return NULL; + /* Fail if rhs is not FULL or a contiguous section. */ + if (expr1->ref && !(gfc_full_array_ref_p (expr1->ref, &c) || c)) + return NULL; + /* Fail if EXPR1 can't be expressed as a descriptor. */ if (gfc_ref_needs_temporary_p (expr1->ref)) return NULL; @@ -4785,7 +4790,7 @@ copyable_array_p (gfc_expr * expr) if (expr->rank < 1 || !expr->ref || expr->ref->next) return false; - if (!gfc_full_array_ref_p (expr->ref)) + if (!gfc_full_array_ref_p (expr->ref, NULL)) return false; /* Next check that it's of a simple enough type. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d325d4a..d8ed7cb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-06-29 Paul Thomas + + PR fortran/40551 + * gfortran.dg/func_assign_2.f90 : New test. + 2009-06-29 Richard Guenther PR middle-end/14187 diff --git a/gcc/testsuite/gfortran.dg/func_assign_2.f90 b/gcc/testsuite/gfortran.dg/func_assign_2.f90 new file mode 100644 index 0000000..e308375 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/func_assign_2.f90 @@ -0,0 +1,33 @@ +! { dg-do run } +! Test the fix for PR40551 in which the assignment +! was not dealing correctly with non-contiguous lhs +! references; eg. a(1,:) +! +! Reported by by Maciej Zwierzycki +! at http://gcc.gnu.org/ml/fortran/2009-06/msg00254.html +! and by Tobias Burnus on Bugzilla +! +integer :: a(2,2) +a = -42 +a(1,:) = func() +if (any (reshape (a, [4]) /= [1, -42, 2, -42])) call abort +a = -42 +a(2,:) = func() +if (any (reshape (a, [4]) /= [-42, 1, -42, 2])) call abort +a = -42 +a(:,1) = func() +if (any (reshape (a, [4]) /= [1, 2, -42, -42])) call abort +a = -42 +a(:,2) = func() +if (any (reshape (a, [4]) /= [-42, -42, 1, 2])) call abort +contains + function func() + integer :: func(2) + call sub(func) + end function func + subroutine sub(a) + integer :: a(2) + a = [1,2] + end subroutine +end + -- 2.7.4