From a828e08e88c3e6553e6d2988ce44b0cd3d675093 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Fri, 14 Dec 2018 16:48:00 +0000 Subject: [PATCH] Avoid undefined behaviour with large right shifts. --- src/microcode/artutl.c | 2 ++ tests/runtime/test-integer-bits.scm | 4 +--- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/microcode/artutl.c b/src/microcode/artutl.c index d3d666a32..114bd0542 100644 --- 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 531d08d9e..8f1991521 100644 --- a/tests/runtime/test-integer-bits.scm +++ b/tests/runtime/test-integer-bits.scm @@ -466,6 +466,4 @@ USA. (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 -- 2.25.1