Avoid undefined behaviour with large right shifts.

diff --git a/src/microcode/artutl.c b/src/microcode/artutl.c
index d3d666a32d28edc47715b92b40dad9b6723d5dde..114bd05428565075134e46418ce75b989b38a2b7 100644 (file)
--- a/src/microcode/artutl.c
+++ b/src/microcode/artutl.c
@@ -696,6 +696,8 @@ integer_shift_right (SCHEME_OBJECT n, unsigned long m)
   if (FIXNUM_P (n))
     {
       long n1 = (FIXNUM_TO_LONG (n));
+      if (m >= (CHAR_BIT * (sizeof (n1))))
+       return (LONG_TO_FIXNUM ((n1 < 0) ? (-1) : 0));
       return (LONG_TO_FIXNUM ((n1 < 0) ? (~ ((~n1) >> m)) : (n1 >> m)));
     }
   else

diff --git a/tests/runtime/test-integer-bits.scm b/tests/runtime/test-integer-bits.scm
index 531d08d9e5ae6800357c56929cf27619b79754eb..8f1991521362a59d58f96cc48d04a613637e4d46 100644 (file)
--- a/tests/runtime/test-integer-bits.scm
+++ b/tests/runtime/test-integer-bits.scm
@@ -466,6 +466,4 @@ USA.
 \f
 (define-test 'SHIFT-RIGHT/TOO-MANY
   (lambda ()
-    (expect-failure
-     (lambda ()
-       (assert-= (shift-right (identity-procedure 1234567) 100) 0)))))
\ No newline at end of file
+    (assert-= (shift-right (identity-procedure 1234567) 100) 0)))
\ No newline at end of file