* [patch, fortran] Fix for modulo checking similar to PR86045
@ 2018-09-03 15:13 Jerry DeLisle
0 siblings, 0 replies; only message in thread
From: Jerry DeLisle @ 2018-09-03 15:13 UTC (permalink / raw)
To: fortran; +Cc: GCC Patches, Mark Eggleston
[-- Attachment #1: Type: text/plain, Size: 539 bytes --]
Hi all,
Similar to Steve's fix of 'mod' checking for 86045, the attached patch
fixes an ICE in 'modulo' when P = 0.
Mark pointed this out and greatly assisted with the patch. I have
regression tested and plan to commit to trunk, 8, and 7 so that we are
in sync with the 'mod' patch.
If no objections, later today I will commit with the test case.
Regards,
Jerry
2018-09-03 Jerry DeLisle <jvdelisle@gcc.gnu.org>
* simplify.c (gfc_simplify_modulo): Re-arrange code to test
whether 'P' is zero and issue an error if it is.
[-- Attachment #2: modulo.diff --]
[-- Type: text/x-patch, Size: 3533 bytes --]
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/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
[-- Attachment #3: modulo_check.f90 --]
[-- Type: text/x-fortran, Size: 410 bytes --]
! { 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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2018-09-03 15:13 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-09-03 15:13 [patch, fortran] Fix for modulo checking similar to PR86045 Jerry DeLisle
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).