From 75d1c00452b12b51121236930d09578bc01f6306 Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Thu, 7 Jun 2018 17:53:11 +0000 Subject: re PR fortran/86045 (ICE in reduce_binary_ac, at fortran/arith.c:1308) 2018-06-07 Steven G. Kargl 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 PR fortran/86045 * gfortran.dg/pr86045.f90: New test. From-SVN: r261286 --- gcc/fortran/simplify.c | 41 +++++++++++++++++++++++------------------ 1 file changed, 23 insertions(+), 18 deletions(-) (limited to 'gcc/fortran/simplify.c') diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index fdd85ed..4199736 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -5473,43 +5473,48 @@ 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"); } -- cgit v1.1