+2009-06-29 Paul Thomas <pault@gcc.gnu.org>
+
+ 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 <burnus@net-b.de>
Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
/* 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;
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]
|| !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;
}
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;
/*********************** 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);
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)
{
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. */
&& 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;
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. */
+2009-06-29 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/40551
+ * gfortran.dg/func_assign_2.f90 : New test.
+
2009-06-29 Richard Guenther <rguenther@suse.de>
PR middle-end/14187
--- /dev/null
+! { 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 <burnus@gcc.gnu.org> 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
+