Fix edge case in 'ash'.

* libguile/numbers.c (left_shift_exact_integer): Fix edge case where
  N is -1 and count is SCM_I_FIXNUM_BIT-1 to return the most negative
  fixnum.  Previously this result was returned as a bignum.

* test-suite/tests/numbers.test (ash): Add tests.

diff --git a/libguile/numbers.c b/libguile/numbers.c
index 6f3a6ec..22b53a5 100644 (file)
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -4978,11 +4978,14 @@ left_shift_exact_integer (SCM n, long count)
     {
       scm_t_inum nn = SCM_I_INUM (n);
 
-      /* Left shift of count >= SCM_I_FIXNUM_BIT-1 will always
+      /* Left shift of count >= SCM_I_FIXNUM_BIT-1 will almost[*] always
          overflow a non-zero fixnum.  For smaller shifts we check the
          bits going into positions above SCM_I_FIXNUM_BIT-1.  If they're
          all 0s for nn>=0, or all 1s for nn<0 then there's no overflow.
-         Those bits are "nn >> (SCM_I_FIXNUM_BIT-1 - count)".  */
+         Those bits are "nn >> (SCM_I_FIXNUM_BIT-1 - count)".
+
+         [*] There's one exception:
+             (-1) << SCM_I_FIXNUM_BIT-1 == SCM_MOST_NEGATIVE_FIXNUM  */
 
       if (nn == 0)
         return n;
@@ -4995,7 +4998,7 @@ left_shift_exact_integer (SCM n, long count)
           SCM result = scm_i_inum2big (nn);
           mpz_mul_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result),
                         count);
-          return result;
+          return scm_i_normbig (result);
         }
     }
   else if (SCM_BIGP (n))

diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 68f8f91..16f06bf 100644 (file)
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -5360,7 +5360,13 @@
 
       (for-each (lambda (n)
                   (for-each (lambda (count) (test n count))
-                            '(-1000 -3 -2 -1 0 1 2 3 1000)))
+                            `(-1000
+                              ,(- fixnum-bit)
+                              ,(- (- fixnum-bit 1))
+                              -3 -2 -1 0 1 2 3
+                              ,(- fixnum-bit 1)
+                              ,fixnum-bit
+                              1000)))
                 (list 0 1 3 23 -1 -3 -23
                       fixnum-max
                       (1+ fixnum-max)