[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 09/55: Gracefully handle huge shift counts in 'ash' and
From: |
Andy Wingo |
Subject: |
[Guile-commits] 09/55: Gracefully handle huge shift counts in 'ash' and 'round-ash'. |
Date: |
Thu, 23 May 2019 11:52:37 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit e4c5f73f94b276c7d62463907365cc1277a1c450
Author: Mark H Weaver <address@hidden>
Date: Sun Oct 14 03:18:35 2018 -0400
Gracefully handle huge shift counts in 'ash' and 'round-ash'.
Fixes <https://bugs.gnu.org/32644>.
Reported by Stefan Israelsson Tampe <address@hidden>.
The need for this arose because the type inferrer for 'ursh' sometimes
passes (- 1 (expt 2 64)) as the second argument to 'ash'.
* libguile/numbers.c (scm_ash, scm_round_ash): Gracefully handle several
cases where the shift count does not fit in a C 'long'.
* test-suite/tests/numbers.test: Add tests.
---
libguile/numbers.c | 37 ++++++++++++++++++++++++++++++++++---
test-suite/tests/numbers.test | 24 ++++++++++++++++++++++--
2 files changed, 56 insertions(+), 5 deletions(-)
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 2c325b9..67295f9 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -1,6 +1,9 @@
-/* Copyright 1995-2016,2018
+/* Copyright 1995-2016,2018-2019
Free Software Foundation, Inc.
+ Portions Copyright 1990-1993 by AT&T Bell Laboratories and Bellcore.
+ See scm_divide.
+
This file is part of Guile.
Guile is free software: you can redistribute it and/or modify it
@@ -5066,7 +5069,21 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0,
{
if (SCM_I_INUMP (n) || SCM_BIGP (n))
{
- long bits_to_shift = scm_to_long (count);
+ long bits_to_shift;
+
+ 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))
+ bits_to_shift = scm_to_long (count);
+ else if (scm_is_false (scm_positive_p (scm_sum (scm_integer_length (n),
+ count))))
+ /* Huge right shift that eliminates all but the sign bit */
+ return scm_is_false (scm_negative_p (n))
+ ? SCM_INUM0 : SCM_I_MAKINUM (-1);
+ else if (scm_is_true (scm_zero_p (n)))
+ return SCM_INUM0;
+ else
+ scm_num_overflow ("ash");
if (bits_to_shift > 0)
return left_shift_exact_integer (n, bits_to_shift);
@@ -5104,7 +5121,21 @@ SCM_DEFINE (scm_round_ash, "round-ash", 2, 0, 0,
{
if (SCM_I_INUMP (n) || SCM_BIGP (n))
{
- long bits_to_shift = scm_to_long (count);
+ long bits_to_shift;
+
+ 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))
+ bits_to_shift = scm_to_long (count);
+ else if (scm_is_false (scm_positive_p (scm_sum (scm_integer_length (n),
+ count))))
+ /* Huge right shift that eliminates all but the sign bit */
+ return scm_is_false (scm_negative_p (n))
+ ? SCM_INUM0 : SCM_I_MAKINUM (-1);
+ else if (scm_is_true (scm_zero_p (n)))
+ return SCM_INUM0;
+ else
+ scm_num_overflow ("round-ash");
if (bits_to_shift > 0)
return left_shift_exact_integer (n, bits_to_shift);
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index a0403a1..4e0bc82 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -1,6 +1,6 @@
;;;; numbers.test --- tests guile's numbers -*- scheme -*-
;;;; Copyright (C) 2000, 2001, 2003-2006, 2009-2013,
-;;;; 2015 Free Software Foundation, Inc.
+;;;; 2015, 2018 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -5421,7 +5421,27 @@
(for-each (lambda (base)
(for-each (lambda (offset) (test (+ base offset) -3))
'(#b11001 #b11100 #b11101 #b10001 #b10100
#b10101)))
- (list 0 64 -64 (* 64 fixnum-max) (* 64 fixnum-min)))))
+ (list 0 64 -64 (* 64 fixnum-max) (* 64 fixnum-min)))
+
+ ;; Huge shift counts
+ (pass-if-equal "Huge left shift of 0"
+ 0
+ (ash-variant 0 (expt 2 1000)))
+ (pass-if-equal "Huge right shift of 0"
+ 0
+ (ash-variant 0 (- (expt 2 1000))))
+ (pass-if-equal "Huge right shift of positive integer"
+ 0
+ (ash-variant 123 (- (expt 2 1000))))
+ (pass-if-equal "Huge right shift of negative integer"
+ -1
+ (ash-variant -123 (- (expt 2 1000))))
+ (pass-if-equal "Huge right shift of -1"
+ -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))
- [Guile-commits] branch master updated (63de189 -> b94c5f8), Andy Wingo, 2019/05/23
- [Guile-commits] 01/55: time: Use 'syntax-rules' instead of 'define-macro'., Andy Wingo, 2019/05/23
- [Guile-commits] 03/55: time: Use #: for 'define-module' clauses., Andy Wingo, 2019/05/23
- [Guile-commits] 02/55: time: Support expressions that return any number of values., Andy Wingo, 2019/05/23
- [Guile-commits] 06/55: Fix 32/64 bit bug in INTEGER_ACCESSOR_PROLOGUE, Andy Wingo, 2019/05/23
- [Guile-commits] 10/55: Fix 'round-ash' of negative integers by huge right shift counts., Andy Wingo, 2019/05/23
- [Guile-commits] 12/55: Clarify the manual's "Processes" section., Andy Wingo, 2019/05/23
- [Guile-commits] 09/55: Gracefully handle huge shift counts in 'ash' and 'round-ash'.,
Andy Wingo <=
- [Guile-commits] 24/55: SRFI-19: time-utc->date: Support non-integer nanoseconds values., Andy Wingo, 2019/05/23
- [Guile-commits] 21/55: SRFI-19: Add a few more tests., Andy Wingo, 2019/05/23
- [Guile-commits] 11/55: In 'ash' and 'round-ash', handle right shift count of LONG_MIN., Andy Wingo, 2019/05/23
- [Guile-commits] 16/55: Add tests for type inferencing for 'nil?' and 'null?' predicates., Andy Wingo, 2019/05/23
- [Guile-commits] 22/55: SRFI-19: Fix normalization of seconds and nanoseconds in time records., Andy Wingo, 2019/05/23
- [Guile-commits] 20/55: SRFI-19: Fix handling of negative years and negative julian days., Andy Wingo, 2019/05/23
- [Guile-commits] 37/55: Avoid leaking a file descriptor in test-unwind, Andy Wingo, 2019/05/23
- [Guile-commits] 38/55: Fix binary output on files created by mkstemp!, Andy Wingo, 2019/05/23
- [Guile-commits] 43/55: Fix typo in comment., Andy Wingo, 2019/05/23
- [Guile-commits] 04/55: Define AT_SYMLINK_NOFOLLOW et al., Andy Wingo, 2019/05/23