diff options
| author | Mark H Weaver <mhw@netris.org> | 2018-10-14 03:18:35 -0400 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2018-10-14 03:27:52 -0400 |
| commit | 011aec7e240ef987931548d90c53e6692c85d01c (patch) | |
| tree | cb22f160cb70de98d7398d479a26e58b5464cba9 /test-suite | |
| parent | fe73fedab40cf716cc39139a61c078e2c9a2f37f (diff) | |
Gracefully handle huge shift counts in 'ash' and 'round-ash'.
Fixes <https://bugs.gnu.org/32644>.
Reported by Stefan Israelsson Tampe <stefan.itampe@gmail.com>.
The need for this arose because the type inferrer for 'ursh' sometimes
passes (- 1 (expt 2 64)) as the second argument to 'ash'.
* libguile/numbers.c (scm_ash, scm_round_ash): Gracefully handle several
cases where the shift count does not fit in a C 'long'.
* test-suite/tests/numbers.test: Add tests.
Diffstat (limited to 'test-suite')
| -rw-r--r-- | test-suite/tests/numbers.test | 24 |
1 files changed, 22 insertions, 2 deletions
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index a0403a118..4e0bc82e5 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -1,6 +1,6 @@ ;;;; numbers.test --- tests guile's numbers -*- scheme -*- ;;;; Copyright (C) 2000, 2001, 2003-2006, 2009-2013, -;;;; 2015 Free Software Foundation, Inc. +;;;; 2015, 2018 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -5421,7 +5421,27 @@ (for-each (lambda (base) (for-each (lambda (offset) (test (+ base offset) -3)) '(#b11001 #b11100 #b11101 #b10001 #b10100 #b10101))) - (list 0 64 -64 (* 64 fixnum-max) (* 64 fixnum-min))))) + (list 0 64 -64 (* 64 fixnum-max) (* 64 fixnum-min))) + + ;; Huge shift counts + (pass-if-equal "Huge left shift of 0" + 0 + (ash-variant 0 (expt 2 1000))) + (pass-if-equal "Huge right shift of 0" + 0 + (ash-variant 0 (- (expt 2 1000)))) + (pass-if-equal "Huge right shift of positive integer" + 0 + (ash-variant 123 (- (expt 2 1000)))) + (pass-if-equal "Huge right shift of negative integer" + -1 + (ash-variant -123 (- (expt 2 1000)))) + (pass-if-equal "Huge right shift of -1" + -1 + (ash-variant -1 (- (expt 2 1000)))) + (pass-if-exception "Huge left shift of non-zero => numerical overflow" + exception:numerical-overflow + (ash-variant 123 (expt 2 1000))))) (test-ash-variant 'ash ash floor) (test-ash-variant 'round-ash round-ash round)) |