[Guile-commits] 02/02: In 'ash' and 'round-ash', handle right shift count of LONG_MIN.

[Mark H. Weaver]

mhw pushed a commit to branch stable-2.2
in repository guile.

commit 1990aa916382d0afcebd5315a6d6f555949ff654
Author: Mark H Weaver <address@hidden>
Date:   Sun Oct 14 05:29:52 2018 -0400

    In 'ash' and 'round-ash', handle right shift count of LONG_MIN.
    
    Fixes <https://bugs.gnu.org/21901>.
    Reported by Zefram <address@hidden>.
    
    * libguile/numbers.c: Add another top-level 'verify' to ensure that
    LONG_MIN is not a fixnum.
    (scm_ash, scm_round_ash): Ensure that when the shift count is LONG_MIN,
    it is not handled via the normal code path, to avoid signed overflow
    when the shift count is negated.
    * test-suite/tests/numbers.test: Add tests.
---
 libguile/numbers.c            | 13 +++++++++++--
 test-suite/tests/numbers.test | 24 ++++++++++++++++++++++++
 2 files changed, 35 insertions(+), 2 deletions(-)

diff --git a/libguile/numbers.c b/libguile/numbers.c
index a01549e..1a04cca 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -5051,6 +5051,11 @@ round_right_shift_exact_integer (SCM n, long count)
     assert (0);
 }
 
+/* 'scm_ash' and 'scm_round_ash' assume that fixnums fit within a long,
+   and moreover that they can be negated without overflow. */
+verify (SCM_MOST_NEGATIVE_FIXNUM >= LONG_MIN + 1
+        && SCM_MOST_POSITIVE_FIXNUM <= LONG_MAX);
+
 SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
             (SCM n, SCM count),
            "Return @math{floor(@var{n} * address@hidden)}.\n"
@@ -5076,7 +5081,9 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
 
       if (SCM_I_INUMP (count))  /* fast path, not strictly needed */
         bits_to_shift = SCM_I_INUM (count);
-      else if (scm_is_signed_integer (count, LONG_MIN, LONG_MAX))
+      else if (scm_is_signed_integer (count, LONG_MIN + 1, LONG_MAX))
+        /* We exclude LONG_MIN to ensure that 'bits_to_shift' can be
+           negated without overflowing. */
         bits_to_shift = scm_to_long (count);
       else if (scm_is_false (scm_positive_p (scm_sum (scm_integer_length (n),
                                                       count))))
@@ -5128,7 +5135,9 @@ SCM_DEFINE (scm_round_ash, "round-ash", 2, 0, 0,
 
       if (SCM_I_INUMP (count))  /* fast path, not strictly needed */
         bits_to_shift = SCM_I_INUM (count);
-      else if (scm_is_signed_integer (count, LONG_MIN, LONG_MAX))
+      else if (scm_is_signed_integer (count, LONG_MIN + 1, LONG_MAX))
+        /* We exclude LONG_MIN to ensure that 'bits_to_shift' can be
+           negated without overflowing. */
         bits_to_shift = scm_to_long (count);
       else if (scm_is_true (scm_negative_p (scm_sum (scm_integer_length (n),
                                                      count)))
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 8cecb06..59e370e 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -5390,11 +5390,19 @@
       (for-each (lambda (n)
                   (for-each (lambda (count) (test n count))
                             `(-1000
+                              ,(* 2 (- fixnum-bit))
+                              ,(- -3 fixnum-bit)
+                              ,(- -2 fixnum-bit)
+                              ,(- -1 fixnum-bit)
                               ,(- fixnum-bit)
                               ,(- (- fixnum-bit 1))
                               -3 -2 -1 0 1 2 3
                               ,(- fixnum-bit 1)
                               ,fixnum-bit
+                              ,(+ fixnum-bit 1)
+                              ,(+ fixnum-bit 2)
+                              ,(+ fixnum-bit 3)
+                              ,(* 2 fixnum-bit)
                               1000)))
                 (list 0 1 3 23 -1 -3 -23
                       fixnum-max
@@ -5423,6 +5431,22 @@
                             '(#b11001 #b11100 #b11101 #b10001 #b10100 
#b10101)))
                 (list 0 64 -64 (* 64 fixnum-max) (* 64 fixnum-min)))
 
+      ;; Right shift by LONG_MIN, typically (ash -1 63) and (ash -1 31)
+      ;; depending on the word size, where negating the shift count
+      ;; overflows.  See <https://bugs.gnu.org/21901>.
+      (pass-if-equal "Right shift of positive integer by (ash -1 63) bits"
+          0
+        (ash-variant 123 (ash -1 63)))
+      (pass-if-equal "Right shift of negative integer by (ash -1 63) bits"
+          (if rounded? 0 -1)
+        (ash-variant -123 (ash -1 63)))
+      (pass-if-equal "Right shift of positive integer by (ash -1 31) bits"
+          0
+        (ash-variant 123 (ash -1 31)))
+      (pass-if-equal "Right shift of negative integer by (ash -1 31) bits"
+          (if rounded? 0 -1)
+        (ash-variant -123 (ash -1 31)))
+
       ;; Huge shift counts
       (pass-if-equal "Huge left shift of 0"
           0