The attached patch re-arranges the code in gfc_simply_mod().
This allows gfortran to test if the 2nd argument is zero.
Tested on i586-*-freebsd and x86_64-*-freebsd. OK to commit?
2018-06-04 Steven G. Kargl <ka...@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-04 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/86045
* gfortran.dg/pr86045.f90: New test.
--
Steve
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c (revision 261171)
+++ gcc/fortran/simplify.c (working copy)
@@ -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;
- 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)
+ /* p shall not be 0. */
+ switch (p->ts.type)
{
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);
+ gfc_error ("Argument %qs of MOD at %L shall not be zero",
+ "P", &p->where);
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);
+ gfc_error ("Argument %qs of MOD at %L shall not be zero",
+ "P", &p->where);
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");
+ }
+
+ 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);
+
+ if (a->ts.type == BT_INTEGER)
+ mpz_tdiv_r (result->value.integer, a->value.integer, p->value.integer);
+ else
+ {
+ gfc_set_model_kind (kind);
+ mpfr_fmod (result->value.real, a->value.real, p->value.real,
+ GFC_RND_MODE);
}
return range_check (result, "MOD");
Index: gcc/testsuite/gfortran.dg/pr86045.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr86045.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr86045.f90 (working copy)
@@ -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
