mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-03 18:30:49 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/91565 (ICE in gfc_simplify_reshape, at fortran/simplify.c:6707 etc.)

Browse Source 
2019-08-28  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/91565
	* simplify.c (gfc_simplify_reshape): Add additional checks of the
	ORDER dummy argument.

2019-08-28  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/91565
	* gfortran.dg/pr91565.f90: New test.

From-SVN: r275007
This commit is contained in:
Steven G. Kargl 2019-08-28 20:16:57 +00:00
parent ab0f6d4c5f
commit 6e12721acd
4 changed files with 59 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2019-08-28 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/91565
* simplify.c (gfc_simplify_reshape): Add additional checks of the
ORDER dummy argument.
2019-08-28 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/91564

34
gcc/fortran/simplify.c
View File

@ -6668,6 +6668,9 @@ gfc_simplify_reshape (gfc_expr *source, gfc_expr *shape_exp,
mpz_init (index);
rank = 0;
for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
x[i] = 0;
for (;;)
{
e = gfc_constructor_lookup_expr (shape_exp->value.constructor, rank);
@ -6692,8 +6695,28 @@ gfc_simplify_reshape (gfc_expr *source, gfc_expr *shape_exp,
}
else
{
for (i = 0; i < rank; i++)
x[i] = 0;
mpz_t size;
int order_size, shape_size;
if (order_exp->rank != shape_exp->rank)
{
gfc_error ("Shapes of ORDER at %L and SHAPE at %L are different",
&order_exp->where, &shape_exp->where);
return &gfc_bad_expr;
}
gfc_array_size (shape_exp, &size);
shape_size = mpz_get_ui (size);
mpz_clear (size);
gfc_array_size (order_exp, &size);
order_size = mpz_get_ui (size);
mpz_clear (size);
if (order_size != shape_size)
{
gfc_error ("Sizes of ORDER at %L and SHAPE at %L are different",
&order_exp->where, &shape_exp->where);
return &gfc_bad_expr;
}
for (i = 0; i < rank; i++)
{
@ -6704,7 +6727,12 @@ gfc_simplify_reshape (gfc_expr *source, gfc_expr *shape_exp,
gcc_assert (order[i] >= 1 && order[i] <= rank);
order[i]--;
gcc_assert (x[order[i]] == 0);
if (x[order[i]] != 0)
{
gfc_error ("ORDER at %L is not a permutation of the size of "
"SHAPE at %L", &order_exp->where, &shape_exp->where);
return &gfc_bad_expr;
}
x[order[i]] = 1;
}
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2019-08-28 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/91565
* gfortran.dg/pr91565.f90: New test.
2019-08-28 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/91564

17
gcc/testsuite/gfortran.dg/pr91565.f90 Normal file
View File

@ -0,0 +1,17 @@
! { dg-do compile }
! PR fortran/91565
! Contributed by Gerhard Steinmetz
program p
integer, parameter :: a(2) = [2,2] ! { dg-error "\(1\)" }
print *, reshape([1,2,3,4,5,6], [2,3], order=a) ! { dg-error "not a permutation" }
end
subroutine foo
integer, parameter :: a(1) = 1 ! { dg-error "\(1\)" }
print *, reshape([1,2,3,4,5,6], [2,3], order=a) ! { dg-error "are different" }
end
subroutine bar
integer, parameter :: a(1,2) = 1 ! { dg-error "\(1\)" }
print *, reshape([1,2,3,4,5,6], [2,3], order=a) ! { dg-error "are different" }
end