From 53dede15de584056ebf6eb4f8d57aa365d9c0e7b Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Mon, 3 Sep 2018 18:38:20 +0000 Subject: [PATCH] simplify.c (gfc_simplify_modulo): Re-arrange code to test whether 'P' is zero and issue an error if it is. 2018-09-03 Jerry DeLisle * simplify.c (gfc_simplify_modulo): Re-arrange code to test whether 'P' is zero and issue an error if it is. * gfortran.dg/modulo_check: New test. From-SVN: r264070 --- gcc/fortran/ChangeLog | 5 ++ gcc/fortran/simplify.c | 61 ++++++++++++---------- gcc/testsuite/ChangeLog | 4 ++ gcc/testsuite/gfortran.dg/modulo_check.f90 | 8 +++ 4 files changed, 49 insertions(+), 29 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/modulo_check.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c386a649583..7cfb94ee115 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2018-09-03 Jerry DeLisle + + * simplify.c (gfc_simplify_modulo): Re-arrange code to test whether + 'P' is zero and issue an error if it is. + 2018-08-31 Paul Thomas PR fortran/86328 diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 41997367cf9..d35bbbaaa1b 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -5525,54 +5525,57 @@ gfc_simplify_modulo (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. This processor just opts - to not handle it at all. */ - gfc_error ("Second argument of MODULO at %L is zero", &a->where); - gfc_free_expr (result); + gfc_error ("Argument %qs of MODULO at %L shall not be zero", + "P", &p->where); return &gfc_bad_expr; } - mpz_fdiv_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 MODULO at %L is zero", &p->where); - gfc_free_expr (result); + gfc_error ("Argument %qs of MODULO 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); - if (mpfr_cmp_ui (result->value.real, 0) != 0) - { - if (mpfr_signbit (a->value.real) != mpfr_signbit (p->value.real)) - mpfr_add (result->value.real, result->value.real, p->value.real, - GFC_RND_MODE); - } - else - mpfr_copysign (result->value.real, result->value.real, - p->value.real, GFC_RND_MODE); break; - default: gfc_internal_error ("gfc_simplify_modulo(): 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_fdiv_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); + if (mpfr_cmp_ui (result->value.real, 0) != 0) + { + if (mpfr_signbit (a->value.real) != mpfr_signbit (p->value.real)) + mpfr_add (result->value.real, result->value.real, p->value.real, + GFC_RND_MODE); + } + else + mpfr_copysign (result->value.real, result->value.real, + p->value.real, GFC_RND_MODE); + } + return range_check (result, "MODULO"); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9828b4b94df..436b4ab8544 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-09-03 Jerry DeLisle + + * gfortran.dg/modulo_check: New test. + 2018-09-03 Richard Biener PR tree-optimization/87177 diff --git a/gcc/testsuite/gfortran.dg/modulo_check.f90 b/gcc/testsuite/gfortran.dg/modulo_check.f90 new file mode 100644 index 00000000000..8819a2f8e4e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/modulo_check.f90 @@ -0,0 +1,8 @@ +! { dg-do compile } +! Test checks on modulo with p == 0 +program p + logical :: a(2) = (modulo([2,3],0) == 0) ! { dg-error "shall not be zero" } + integer :: b = count(modulo([2,3],0) == 0) ! { dg-error "shall not be zero" } + integer :: c = all(modulo([2,3],0) == 0) ! { dg-error "shall not be zero" } + integer :: d = any(modulo([2,3],0) == 0) ! { dg-error "shall not be zero" } +end program -- 2.30.2