re PR fortran/40551 (Optimizations possible using gfc_full_array_ref_p)
2009-07-05 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-07-05 Paul Thomas <pault@gcc.gnu.org> PR fortran/40551 * gfortran.dg/func_assign_2.f90 : New test. From-SVN: r149261
This commit is contained in:
parent
eebcaed152
commit
8d8162ce01
|
@ -1,3 +1,17 @@
|
|||
2009-07-05 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-07-04 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): For integer
|
||||
|
|
|
@ -1186,17 +1186,28 @@ 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 (contiguous)
|
||||
*contiguous = false;
|
||||
|
||||
if (ref->type != REF_ARRAY)
|
||||
return false;
|
||||
if (ref->u.ar.type == AR_FULL)
|
||||
return true;
|
||||
{
|
||||
if (contiguous)
|
||||
*contiguous = true;
|
||||
return true;
|
||||
}
|
||||
if (ref->u.ar.type != AR_SECTION)
|
||||
return false;
|
||||
if (ref->next)
|
||||
|
@ -1209,6 +1220,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 +1243,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;
|
||||
}
|
||||
|
@ -1284,11 +1306,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;
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -4822,7 +4822,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)
|
||||
{
|
||||
|
|
|
@ -4255,6 +4255,7 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
|
|||
gfc_ss *ss;
|
||||
gfc_ref * ref;
|
||||
bool seen_array_ref;
|
||||
bool c = false;
|
||||
|
||||
/* The caller has already checked rank>0 and expr_type == EXPR_FUNCTION. */
|
||||
if (expr2->value.function.isym && !gfc_is_intrinsic_libcall (expr2))
|
||||
|
@ -4265,6 +4266,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;
|
||||
|
@ -4721,7 +4726,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. */
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2009-07-05 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/40551
|
||||
* gfortran.dg/func_assign_2.f90 : New test.
|
||||
|
||||
2009-07-04 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
* gfortran.dg/maxloc_1.f90: New test.
|
||||
|
|
|
@ -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 <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
|
||||
|
Loading…
Reference in New Issue