Fix 'round-ash' of negative integers by huge right shift counts.

This is a followup to commit 011aec7e240ef987931548d90c53e6692c85d01c.

When rounding, right shifting a negative integer by a huge shift count
results in 0, not -1.

* libguile/numbers.c: Add top-level 'verify' to ensure that the
assumptions in 'scm_ash' and 'scm_round_ash' are valid.
(scm_round_ash): In the case that handles huge right shifts, require
that the shift count _exceeds_ the integer length, and return 0 instead
of -1.
* test-suite/tests/numbers.test: Adjust tests accordingly.

1 files changed, 5 insertions, 5 deletions

diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 4e0bc82e5..8cecb06ad 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -5377,7 +5377,7 @@
 ;;;
 
 (let ()
-  (define (test-ash-variant name ash-variant round-variant)
+  (define (test-ash-variant name ash-variant round-variant rounded?)
     (with-test-prefix name
       (define (test n count)
         (pass-if (list n count)
@@ -5434,17 +5434,17 @@
           0
         (ash-variant 123 (- (expt 2 1000))))
       (pass-if-equal "Huge right shift of negative integer"
-          -1
+          (if rounded? 0 -1)
         (ash-variant -123 (- (expt 2 1000))))
       (pass-if-equal "Huge right shift of -1"
-          -1
+          (if rounded? 0 -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))
+  (test-ash-variant       'ash       ash floor #f)
+  (test-ash-variant 'round-ash round-ash round #t))
 
 ;;;
 ;;; regressions