Commit fcd44320 by Roger Sayle

re PR fortran/30207 (ICE in gfc_dep_resolver with where (a < 0) a(:) = 1)

2006-12-17  Roger Sayle  <roger@eyesopen.com>
	    Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/30207
	* dependency.c (gfc_full_array_ref_p): New function to test whether
	the given array ref specifies the entire array.
	(gfc_dep_resolver): Use gfc_full_array_ref_p to analyze AR_FULL
	array refs against AR_SECTION array refs, and vice versa.
	* dependency.h (gfc_full_array_ref_p): Prototype here.
	* trans-array.c (gfc_conv_expr_descriptor): Use gfc_full_array_ref_p.

	* gfortran.fortran-torture/execute/where21.f90: New test.

From-SVN: r119990
parent 2ef73bb4
2006-12-17 Roger Sayle <roger@eyesopen.com>
PR fortran/30207
* dependency.c (gfc_full_array_ref_p): New function to test whether
the given array ref specifies the entire array.
(gfc_dep_resolver): Use gfc_full_array_ref_p to analyze AR_FULL
array refs against AR_SECTION array refs, and vice versa.
* dependency.h (gfc_full_array_ref_p): Prototype here.
* trans-array.c (gfc_conv_expr_descriptor): Use gfc_full_array_ref_p.
2006-12-16 Brooks Moses <brooks.moses@codesourcery.com>
* gfortran.texi: Added TeX support for document parts;
......
......@@ -1108,6 +1108,46 @@ 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. */
bool
gfc_full_array_ref_p (gfc_ref *ref)
{
int i;
if (ref->type != REF_ARRAY)
return false;
if (ref->u.ar.type == AR_FULL)
return true;
if (ref->u.ar.type != AR_SECTION)
return false;
for (i = 0; i < ref->u.ar.dimen; i++)
{
/* Check the lower bound. */
if (ref->u.ar.start[i]
&& (!ref->u.ar.as
|| !ref->u.ar.as->lower[i]
|| gfc_dep_compare_expr (ref->u.ar.start[i],
ref->u.ar.as->lower[i])))
return 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;
/* Check the stride. */
if (ref->u.ar.stride[i]
&& !gfc_expr_is_one (ref->u.ar.stride[i], 0))
return false;
}
return true;
}
/* Finds if two array references are overlapping or not.
Return value
1 : array references are overlapping.
......@@ -1145,6 +1185,19 @@ gfc_dep_resolver (gfc_ref * lref, gfc_ref * rref)
return 0;
case REF_ARRAY:
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;
else if (rref->u.ar.type == AR_FULL)
fin_dep = gfc_full_array_ref_p (lref) ? GFC_DEP_EQUAL
: GFC_DEP_OVERLAP;
else
return 1;
break;
}
for (n=0; n < lref->u.ar.dimen; n++)
{
/* Assume dependency when either of array reference is vector
......
......@@ -22,6 +22,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
bool gfc_ref_needs_temporary_p (gfc_ref *);
bool gfc_full_array_ref_p (gfc_ref *);
gfc_expr *gfc_get_noncopying_intrinsic_argument (gfc_expr *);
int gfc_check_fncall_dependency (gfc_expr *, sym_intent, gfc_symbol *,
gfc_actual_arglist *);
......
......@@ -4147,7 +4147,6 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
tree start;
tree offset;
int full;
gfc_ref *ref;
gcc_assert (ss != gfc_ss_terminator);
......@@ -4184,25 +4183,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
else if (se->direct_byref)
full = 0;
else
{
ref = info->ref;
gcc_assert (ref->u.ar.type == AR_SECTION);
full = 1;
for (n = 0; n < ref->u.ar.dimen; n++)
{
/* Detect passing the full array as a section. This could do
even more checking, but it doesn't seem worth it. */
if (ref->u.ar.start[n]
|| ref->u.ar.end[n]
|| (ref->u.ar.stride[n]
&& !gfc_expr_is_one (ref->u.ar.stride[n], 0)))
{
full = 0;
break;
}
}
}
full = gfc_full_array_ref_p (info->ref);
if (full)
{
......
2006-12-17 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/30207
* gfortran.fortran-torture/execute/where21.f90: New test.
2006-12-17 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/associated_2.f90: Add test for associated(NULL,NULL).
! { dg-do run }
! Test fix for PR fortran/30207.
program a
implicit none
integer, parameter :: i(4) = (/ 1, 1, 1, 1 /)
integer :: z(4) = (/ 1, 1, -1, -1 /)
where(z < 0) z(:) = 1
if (any(z /= i)) call abort
end program a
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