mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-23 08:29:22 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR libfortran/27895 (problem with RESHAPE and zero-sized arrays)

Browse Source 
PR libfortran/27895

	* resolve.c (compute_last_value_for_triplet): New function.
	(check_dimension): Correctly handle zero-sized array sections.
	Add checking on last element of array sections.

	* gfortran.dg/bounds_check_3.f90: New test.

From-SVN: r114414
This commit is contained in:
François-Xavier Coudert 2006-06-05 22:41:29 +00:00
parent 36ac3ed6b7
commit 0094f36221
4 changed files with 192 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
2006-06-05 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR libfortran/27895
* resolve.c (compute_last_value_for_triplet): New function.
(check_dimension): Correctly handle zero-sized array sections.
Add checking on last element of array sections.
2006-06-05 Steven G. Kargl <kargls@comcast.net>
* data.c (gfc_assign_data_value): Fix comment typo. Remove

112
gcc/fortran/resolve.c
View File

@ -2100,12 +2100,86 @@ compare_bound_int (gfc_expr * a, int b)
}
/* Compare an integer expression with a mpz_t. */
static comparison
compare_bound_mpz_t (gfc_expr * a, mpz_t b)
{
int i;
if (a == NULL || a->expr_type != EXPR_CONSTANT)
return CMP_UNKNOWN;
if (a->ts.type != BT_INTEGER)
gfc_internal_error ("compare_bound_int(): Bad expression");
i = mpz_cmp (a->value.integer, b);
if (i < 0)
return CMP_LT;
if (i > 0)
return CMP_GT;
return CMP_EQ;
}
/* Compute the last value of a sequence given by a triplet.
Return 0 if it wasn't able to compute the last value, or if the
sequence if empty, and 1 otherwise. */
static int
compute_last_value_for_triplet (gfc_expr * start, gfc_expr * end,
gfc_expr * stride, mpz_t last)
{
mpz_t rem;
if (start == NULL || start->expr_type != EXPR_CONSTANT
|| end == NULL || end->expr_type != EXPR_CONSTANT
|| (stride != NULL && stride->expr_type != EXPR_CONSTANT))
return 0;
if (start->ts.type != BT_INTEGER || end->ts.type != BT_INTEGER
|| (stride != NULL && stride->ts.type != BT_INTEGER))
return 0;
if (stride == NULL || compare_bound_int(stride, 1) == CMP_EQ)
{
if (compare_bound (start, end) == CMP_GT)
return 0;
mpz_set (last, end->value.integer);
return 1;
}
if (compare_bound_int (stride, 0) == CMP_GT)
{
/* Stride is positive */
if (mpz_cmp (start->value.integer, end->value.integer) > 0)
return 0;
}
else
{
/* Stride is negative */
if (mpz_cmp (start->value.integer, end->value.integer) < 0)
return 0;
}
mpz_init (rem);
mpz_sub (rem, end->value.integer, start->value.integer);
mpz_tdiv_r (rem, rem, stride->value.integer);
mpz_sub (last, end->value.integer, rem);
mpz_clear (rem);
return 1;
}
/* Compare a single dimension of an array reference to the array
specification. */
static try
check_dimension (int i, gfc_array_ref * ar, gfc_array_spec * as)
{
mpz_t last_value;
/* Given start, end and stride values, calculate the minimum and
maximum referenced indexes. */
@ -2130,13 +2204,41 @@ check_dimension (int i, gfc_array_ref * ar, gfc_array_spec * as)
return FAILURE;
}
if (compare_bound (ar->start[i], as->lower[i]) == CMP_LT)
goto bound;
if (compare_bound (ar->start[i], as->upper[i]) == CMP_GT)
#define AR_START (ar->start[i] ? ar->start[i] : as->lower[i])
#define AR_END (ar->end[i] ? ar->end[i] : as->upper[i])
if (compare_bound (AR_START, AR_END) == CMP_EQ
&& (compare_bound (AR_START, as->lower[i]) == CMP_LT
|| compare_bound (AR_START, as->upper[i]) == CMP_GT))
goto bound;
/* TODO: Possibly, we could warn about end[i] being out-of-bound although
it is legal (see 6.2.2.3.1). */
if (((compare_bound_int (ar->stride[i], 0) == CMP_GT
|| ar->stride[i] == NULL)
&& compare_bound (AR_START, AR_END) != CMP_GT)
|| (compare_bound_int (ar->stride[i], 0) == CMP_LT
&& compare_bound (AR_START, AR_END) != CMP_LT))
{
if (compare_bound (AR_START, as->lower[i]) == CMP_LT)
goto bound;
if (compare_bound (AR_START, as->upper[i]) == CMP_GT)
goto bound;
}
mpz_init (last_value);
if (compute_last_value_for_triplet (AR_START, AR_END, ar->stride[i],
last_value))
{
if (compare_bound_mpz_t (as->lower[i], last_value) == CMP_GT
|| compare_bound_mpz_t (as->upper[i], last_value) == CMP_LT)
{
mpz_clear (last_value);
goto bound;
}
}
mpz_clear (last_value);
#undef AR_START
#undef AR_END
break;

13
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2006-06-05 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR libfortran/27895
* gfortran.dg/bounds_check_3.f90: New test.
2006-06-05 Mike Stump <mrs@apple.com>
* objc.dg/objc-fast-4.m: Skip for ppc64.
@ -10,10 +15,10 @@
2006-06-05 Dorit Nuzman <dorit@il.ibm.com>
Victor Kaplansky <victork@il.ibm.com>
PR tree-optimizations/26360
* gcc.dg/vect/vect.exp: Compile tests prefixed with "no-tree-dce"
with -fno-tree-dce.
* gcc.dg/vect/no-tree-dce-pr26360.c: New test.
PR tree-optimizations/26360
* gcc.dg/vect/vect.exp: Compile tests prefixed with "no-tree-dce"
with -fno-tree-dce.
* gcc.dg/vect/no-tree-dce-pr26360.c: New test.
2006-06-05 Paul Thomas <pault@gcc.gnu.org>

69
gcc/testsuite/gfortran.dg/bounds_check_3.f90 Normal file
View File

@ -0,0 +1,69 @@
! { dg-do compile }
integer,parameter :: n = 5, m = 8
integer a(10), i
print *, a(15:14) ! don't warn
print *, a(14:15) ! { dg-warning "is out of bounds" }
print *, a(-5:-6) ! don't warn
print *, a(-6:-5) ! { dg-warning "is out of bounds" }
print *, a(15:14:1) ! don't warn
print *, a(14:15:1) ! { dg-warning "is out of bounds" }
print *, a(-5:-6:1) ! don't warn
print *, a(-6:-5:1) ! { dg-warning "is out of bounds" }
print *, a(15:14:-1) ! { dg-warning "is out of bounds" }
print *, a(14:15:-1) ! don't warn
print *, a(-5:-6:-1) ! { dg-warning "is out of bounds" }
print *, a(-6:-5:-1) ! don't warn
print *, a(15:) ! don't warn
print *, a(15::-1) ! { dg-warning "is out of bounds" }
print *, a(-1:) ! { dg-warning "is out of bounds" }
print *, a(-1::-1) ! don't warn
print *, a(:-1) ! don't warn
print *, a(:-1:-1) ! { dg-warning "is out of bounds" }
print *, a(:11) ! { dg-warning "is out of bounds" }
print *, a(:11:-1) ! don't warn
print *, a(1:20:10) ! { dg-warning "is out of bounds" }
print *, a(1:15:15) ! don't warn
print *, a(1:16:15) ! { dg-warning "is out of bounds" }
print *, a(10:15:6) ! don't warn
print *, a(11:15:6) ! { dg-warning "is out of bounds" }
print *, a(11:-5:6) ! don't warn
print *, a(10:-8:-9) ! { dg-warning "is out of bounds" }
print *, a(10:-7:-9) ! don't warn
print *, a(0:0:-1) ! { dg-warning "is out of bounds" }
print *, a(0:0:1) ! { dg-warning "is out of bounds" }
print *, a(0:0) ! { dg-warning "is out of bounds" }
print *, a(1:15:i) ! don't warn
print *, a(1:15:n) ! { dg-warning "is out of bounds" }
print *, a(1:15:m) ! don't warn
print *, a(1:-5:-m) ! don't warn
print *, a(1:-5:-n) ! { dg-warning "is out of bounds" }
print *, a(1:-5:-i) ! don't warn
print *, a(-5:-5) ! { dg-warning "is out of bounds" }
print *, a(15:15) ! { dg-warning "is out of bounds" }
print *, a(-5:-5:1) ! { dg-warning "is out of bounds" }
print *, a(15:15:-1) ! { dg-warning "is out of bounds" }
print *, a(-5:-5:2) ! { dg-warning "is out of bounds" }
print *, a(15:15:-2) ! { dg-warning "is out of bounds" }
print *, a(-5:-5:n) ! { dg-warning "is out of bounds" }
print *, a(15:15:-n) ! { dg-warning "is out of bounds" }
print *, a(-5:-5:i) ! { dg-warning "is out of bounds" }
print *, a(15:15:-i) ! { dg-warning "is out of bounds" }
print *, a(5:5) ! don't warn
print *, a(5:5:1) ! don't warn
print *, a(5:5:-1) ! don't warn
print *, a(5:5:2) ! don't warn
print *, a(5:5:-2) ! don't warn
print *, a(5:5:n) ! don't warn
print *, a(5:5:-n) ! don't warn
print *, a(5:5:i) ! don't warn
print *, a(5:5:-i) ! don't warn
end