OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/80442 (Rejects DATA statement with array slice)

Browse Source 
2017-05-09  Nicolas Koenig  <koenigni@student.ethz.ch>

	PR fortran/80442
	* array.c (gfc_ref_dimen_size): Simplify stride
	expression
	* data.c (gfc_advance_section): Simplify start,
	end and stride expressions
	(gfc_advance_section): Simplify start and end
	expressions
	(gfc_get_section_index): Simplify start expression 

2017-05-09  Nicolas Koenig  <koenigni@student.ethz.ch>

	PR fortran/80442
	* gfortran.dg/impl_do_var_data.f90: New Test

From-SVN: r248012
This commit is contained in:
Nicolas Koenig 2017-05-14 01:38:36 +02:00 committed by Nicolas Koenig
parent 364490206e
commit 28ae01cd23
5 changed files with 66 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View File

@ -1,3 +1,14 @@
2017-05-14 Nicolas Koenig <koenigni@student.ethz.ch>
PR fortran/80442
* array.c (gfc_ref_dimen_size): Simplify stride
expression
* data.c (gfc_advance_section): Simplify start,
end and stride expressions
(gfc_advance_section): Simplify start and end
expressions
(gfc_get_section_index): Simplify start expression
2017-05-13 Jerry DeLisle <jvdelisle@gcc.gnu.org>
* io.c (gfc_resolve_dt): Fix returns to bool type.

9
gcc/fortran/array.c
View File

@ -2201,6 +2201,7 @@ gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end)
mpz_t upper, lower, stride;
mpz_t diff;
bool t;
gfc_expr *stride_expr = NULL;
if (dimen < 0 || ar == NULL || dimen > ar->dimen - 1)
gfc_internal_error ("gfc_ref_dimen_size(): Bad dimension");
@ -2225,12 +2226,16 @@ gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end)
mpz_set_ui (stride, 1);
else
{
if (ar->stride[dimen]->expr_type != EXPR_CONSTANT)
stride_expr = gfc_copy_expr(ar->stride[dimen]);
if(!gfc_simplify_expr(stride_expr, 1))
gfc_internal_error("Simplification error");
if (stride_expr->expr_type != EXPR_CONSTANT)
{
mpz_clear (stride);
return false;
}
mpz_set (stride, ar->stride[dimen]->value.integer);
mpz_set (stride, stride_expr->value.integer);
gfc_free_expr(stride_expr);
}
/* Calculate the number of elements via gfc_dep_differce, but only if

40
gcc/fortran/data.c
View File

@ -539,6 +539,7 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
mpz_t tmp;
bool forwards;
int cmp;
gfc_expr *start, *end, *stride;
for (i = 0; i < ar->dimen; i++)
{
@ -547,12 +548,16 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
if (ar->stride[i])
{
stride = gfc_copy_expr(ar->stride[i]);
if(!gfc_simplify_expr(stride, 1))
gfc_internal_error("Simplification error");
mpz_add (section_index[i], section_index[i],
ar->stride[i]->value.integer);
if (mpz_cmp_si (ar->stride[i]->value.integer, 0) >= 0)
forwards = true;
else
forwards = false;
stride->value.integer);
if (mpz_cmp_si (stride->value.integer, 0) >= 0)
forwards = true;
else
forwards = false;
gfc_free_expr(stride);
}
else
{
@ -561,7 +566,13 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
}
if (ar->end[i])
cmp = mpz_cmp (section_index[i], ar->end[i]->value.integer);
{
end = gfc_copy_expr(ar->end[i]);
if(!gfc_simplify_expr(end, 1))
gfc_internal_error("Simplification error");
cmp = mpz_cmp (section_index[i], end->value.integer);
gfc_free_expr(end);
}
else
cmp = mpz_cmp (section_index[i], ar->as->upper[i]->value.integer);
@ -569,7 +580,13 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
{
/* Reset index to start, then loop to advance the next index. */
if (ar->start[i])
mpz_set (section_index[i], ar->start[i]->value.integer);
{
start = gfc_copy_expr(ar->start[i]);
if(!gfc_simplify_expr(start, 1))
gfc_internal_error("Simplification error");
mpz_set (section_index[i], start->value.integer);
gfc_free_expr(start);
}
else
mpz_set (section_index[i], ar->as->lower[i]->value.integer);
}
@ -679,6 +696,7 @@ gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset)
int i;
mpz_t delta;
mpz_t tmp;
gfc_expr *start;
mpz_set_si (*offset, 0);
mpz_init (tmp);
@ -692,11 +710,15 @@ gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset)
case DIMEN_RANGE:
if (ar->start[i])
{
mpz_sub (tmp, ar->start[i]->value.integer,
start = gfc_copy_expr(ar->start[i]);
if(!gfc_simplify_expr(start, 1))
gfc_internal_error("Simplification error");
mpz_sub (tmp, start->value.integer,
ar->as->lower[i]->value.integer);
mpz_mul (tmp, tmp, delta);
mpz_add (*offset, tmp, *offset);
mpz_set (section_index[i], ar->start[i]->value.integer);
mpz_set (section_index[i], start->value.integer);
gfc_free_expr(start);
}
else
mpz_set (section_index[i], ar->as->lower[i]->value.integer);

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2017-05-14 Nicolas Koenig <koenigni@student.ethz.ch>
PR fortran/80442
* gfortran.dg/impl_do_var_data.f90: New Test
2017-05-13 Pekka Jääskeläinen <pekka.jaaskelainen@parmance.com>
* brig.dg/test/gimple/priv-array-offset-access.hsail:

12
gcc/testsuite/gfortran.dg/impl_do_var_data.f90 Normal file
View File

@ -0,0 +1,12 @@
! { dg-do run }
! PR 80442
! This test case used to produce an bogus error
! about the variables being below the lower
! array bounds
program main
implicit none
integer:: i
integer, dimension(3):: A
data (A(i:i+2:i+1), i=1,2) /1, 2, 3/
if(any(A .ne. [1,3,2])) call abort()
end program