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

re PR fortran/86045 (ICE in reduce_binary_ac, at fortran/arith.c:1308)

Browse source 
2018-06-07  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/86045
	* simplify.c (gfc_simplify_mod): Re-arrange code to test whether
	'P' is zero and issue an error if it is.

2018-06-07  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/86045
	* gfortran.dg/pr86045.f90: New test.

From-SVN: r261286
This commit is contained in:
Steven G. Kargl 2018-06-07 17:53:11 +00:00
parent dc23fb4d72
commit 75d1c00452
4 changed files with 52 additions and 29 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 @@
2018-06-07 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/86045
* simplify.c (gfc_simplify_mod): Re-arrange code to test whether
'P' is zero and issue an error if it is.
2018-06-06 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/85641

63
gcc/fortran/simplify.c
View file

@ -5473,41 +5473,46 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p)
gfc_expr *result;
int kind;
if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT)
/* First check p. */
if (p->expr_type != EXPR_CONSTANT)
return NULL;
/* p shall not be 0. */
switch (p->ts.type)
{
case BT_INTEGER:
if (mpz_cmp_ui (p->value.integer, 0) == 0)
{
gfc_error ("Argument %qs of MOD at %L shall not be zero",
"P", &p->where);
return &gfc_bad_expr;
}
break;
case BT_REAL:
if (mpfr_cmp_ui (p->value.real, 0) == 0)
{
gfc_error ("Argument %qs of MOD at %L shall not be zero",
"P", &p->where);
return &gfc_bad_expr;
}
break;
default:
gfc_internal_error ("gfc_simplify_mod(): Bad arguments");
}
if (a->expr_type != EXPR_CONSTANT)
return NULL;
kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind;
result = gfc_get_constant_expr (a->ts.type, kind, &a->where);
switch (a->ts.type)
if (a->ts.type == BT_INTEGER)
mpz_tdiv_r (result->value.integer, a->value.integer, p->value.integer);
else
{
case BT_INTEGER:
if (mpz_cmp_ui (p->value.integer, 0) == 0)
{
/* Result is processor-dependent. */
gfc_error ("Second argument MOD at %L is zero", &a->where);
gfc_free_expr (result);
return &gfc_bad_expr;
}
mpz_tdiv_r (result->value.integer, a->value.integer, p->value.integer);
break;
case BT_REAL:
if (mpfr_cmp_ui (p->value.real, 0) == 0)
{
/* Result is processor-dependent. */
gfc_error ("Second argument of MOD at %L is zero", &p->where);
gfc_free_expr (result);
return &gfc_bad_expr;
}
gfc_set_model_kind (kind);
mpfr_fmod (result->value.real, a->value.real, p->value.real,
GFC_RND_MODE);
break;
default:
gfc_internal_error ("gfc_simplify_mod(): Bad arguments");
gfc_set_model_kind (kind);
mpfr_fmod (result->value.real, a->value.real, p->value.real,
GFC_RND_MODE);
}
return range_check (result, "MOD");

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2018-06-07 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/86045
* gfortran.dg/pr86045.f90: New test.
2018-06-07 Marek Polacek <polacek@redhat.com>
* g++.dg/cpp0x/range-for9.C: Adjust dg-error.

7
gcc/testsuite/gfortran.dg/pr86045.f90 Normal file
View file

@ -0,0 +1,7 @@
! { dg-do compile }
program p
logical :: a(2) = (mod([2,3],0) == 0) ! { dg-error "shall not be zero" }
integer :: b = count(mod([2,3],0) == 0) ! { dg-error "shall not be zero" }
integer :: c = all(mod([2,3],0) == 0) ! { dg-error "shall not be zero" }
integer :: d = any(mod([2,3],0) == 0) ! { dg-error "shall not be zero" }
end