procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/84931 (Expansion of array constructor with constant implied-do-object goes sideways)

Browse source 
2018-03-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84931
	* simplify.c (gfc_convert_constant): Handle case of array
	constructors within an array that has no iterator and improve
	the conciseness of this section of code.

2018-03-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84931
	* gfortran.dg/array_constructor_53.f90: New test.

From-SVN: r258977
This commit is contained in:
Paul Thomas 2018-03-30 12:33:49 +00:00
parent 13b5a6bf00
commit 0ada0dc0c6
4 changed files with 57 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View file

@ -1,3 +1,10 @@
2018-03-30 Paul Thomas <pault@gcc.gnu.org>
PR fortran/84931
* simplify.c (gfc_convert_constant): Handle case of array
constructors within an array that has no iterator and improve
the conciseness of this section of code.
2017-03-30 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/85111
@ -12,7 +19,7 @@
PR fortran/69497
* symbol.c (gfc_symbol_done_2): Start freeing namespaces
from the root.
(gfc_free_namespace): Restore assert (revert r258839).
(gfc_free_namespace): Restore assert (revert r258839).
2018-03-28 Jakub Jelinek <jakub@redhat.com>

57
gcc/fortran/simplify.c
View file

@ -380,7 +380,7 @@ compute_dot_product (gfc_expr *matrix_a, int stride_a, int offset_a,
{
gfc_expr *result, *a, *b, *c;
/* Set result to an INTEGER(1) 0 for numeric types and .false. for
/* Set result to an INTEGER(1) 0 for numeric types and .false. for
LOGICAL. Mixed-mode math in the loop will promote result to the
correct type and kind. */
if (matrix_a->ts.type == BT_LOGICAL)
@ -2086,7 +2086,7 @@ gfc_simplify_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim)
}
else
shiftvec = NULL;
/* Shut up compiler */
len = 1;
rsoffset = 1;
@ -2296,7 +2296,7 @@ gfc_simplify_dim (gfc_expr *x, gfc_expr *y)
gfc_expr*
gfc_simplify_dot_product (gfc_expr *vector_a, gfc_expr *vector_b)
{
/* If vector_a is a zero-sized array, the result is 0 for INTEGER,
/* If vector_a is a zero-sized array, the result is 0 for INTEGER,
REAL, and COMPLEX types and .false. for LOGICAL. */
if (vector_a->shape && mpz_get_si (vector_a->shape[0]) == 0)
{
@ -2423,7 +2423,7 @@ gfc_simplify_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
{
if (boundary->rank > 0)
gfc_simplify_expr (boundary, 1);
if (!gfc_is_constant_expr (boundary))
return NULL;
}
@ -2443,7 +2443,7 @@ gfc_simplify_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
temp_boundary = true;
switch (array->ts.type)
{
case BT_INTEGER:
bnd = gfc_get_int_expr (array->ts.kind, NULL, 0);
break;
@ -2477,7 +2477,7 @@ gfc_simplify_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
temp_boundary = false;
bnd = boundary;
}
gfc_array_size (array, &size);
arraysize = mpz_get_ui (size);
mpz_clear (size);
@ -2615,7 +2615,7 @@ gfc_simplify_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
if (bnd_ctor)
bnd_ctor = gfc_constructor_next (bnd_ctor);
count[0]++;
n = 0;
while (count[n] == extent[n])
@ -5316,7 +5316,7 @@ simplify_minmaxloc_to_array (gfc_expr *result, gfc_expr *array,
if (*src && min_max_choose (*src, ex, sign) > 0)
mpz_set_si ((*dest)->value.integer, n + 1);
}
count[0]++;
base += sstride[0];
dest += dstride[0];
@ -5373,7 +5373,7 @@ gfc_simplify_minmaxloc (gfc_expr *array, gfc_expr *dim, gfc_expr *mask,
gfc_expr *extremum;
int ikind;
int init_val;
if (!is_constant_array_expr (array)
|| !gfc_is_constant_expr (dim))
return NULL;
@ -7879,8 +7879,8 @@ gfc_simplify_xor (gfc_expr *x, gfc_expr *y)
gfc_expr *
gfc_convert_constant (gfc_expr *e, bt type, int kind)
{
gfc_expr *g, *result, *(*f) (gfc_expr *, int);
gfc_constructor *c;
gfc_expr *result, *(*f) (gfc_expr *, int);
gfc_constructor *c, *t;
switch (e->ts.type)
{
@ -8017,31 +8017,24 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
gfc_expr *tmp;
if (c->iterator == NULL)
{
tmp = f (c->expr, kind);
if (tmp == NULL)
{
gfc_free_expr (result);
return NULL;
}
gfc_constructor_append_expr (&result->value.constructor,
tmp, &c->where);
if (c->expr->expr_type == EXPR_ARRAY)
tmp = gfc_convert_constant (c->expr, type, kind);
else
tmp = f (c->expr, kind);
}
else
tmp = gfc_convert_constant (c->expr, type, kind);
if (tmp == NULL || tmp == &gfc_bad_expr)
{
gfc_constructor *n;
g = gfc_convert_constant (c->expr, type, kind);
if (g == NULL || g == &gfc_bad_expr)
{
gfc_free_expr (result);
return g;
}
n = gfc_constructor_get ();
n->expr = g;
n->iterator = gfc_copy_iterator (c->iterator);
n->where = c->where;
gfc_constructor_append (&result->value.constructor, n);
gfc_free_expr (result);
return NULL;
}
t = gfc_constructor_append_expr (&result->value.constructor,
tmp, &c->where);
if (c->iterator)
t->iterator = gfc_copy_iterator (c->iterator);
}
break;

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2018-03-30 Paul Thomas <pault@gcc.gnu.org>
PR fortran/84931
* gfortran.dg/array_constructor_53.f90: New test.
2018-03-30 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/85130

19
gcc/testsuite/gfortran.dg/array_constructor_53.f90 Normal file
View file

@ -0,0 +1,19 @@
! { dg-do run }
! PR 84931 - long array constructors with type conversion were not
! handled correctly. array_constructor_52.f90 tests the original
! problem.
program test
implicit none
integer, parameter :: n = 2**16 + 1
real, dimension(n) :: y
real, dimension(2*n) :: z
integer :: i
y = [33, (1, i=1, n-1) ] ! Check that something more complicated works
if (int(y(3)) /= 1) stop 1
z = [[(1, i=1, n) ],[(2, i=1, n) ]] ! Failed with first version of the fix
if (int(z(2)) /= 1) stop 2
if (int(z(n+1)) /= 2) stop 3
end program test