1.0.27.2: fix bug in heap implementation

... used by timers.

Thanks to Ole Arndt for the patch.

diff --git a/NEWS b/NEWS
index 7059a78..cdc89ef 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,4 +1,8 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
+changes in sbcl-1.0.28 relative to 1.0.27:
+  * bug fix: timers could go off in the wrong order, be delayed indefinitely
+    (thanks to Ole Arndt for the patch)
+
 changes in sbcl-1.0.27 relative to 1.0.26:
   * new port: support added for x86-64 OpenBSD. (thanks to Josh Elsasser)
   * new port: support added for x86-64 Solaris. (thanks to Alex Viskovatoff)

diff --git a/src/code/timer.lisp b/src/code/timer.lisp
index d7c0c13..5a1f4fa 100644 (file)
--- a/src/code/timer.lisp
+++ b/src/code/timer.lisp
@@ -16,7 +16,7 @@
 (declaim (inline heap-parent heap-left heap-right))
 
 (defun heap-parent (i)
-  (ash i -1))
+  (ash (1- i) -1))
 
 (defun heap-left (i)
   (1+ (ash i 1)))

diff --git a/tests/timer.impure.lisp b/tests/timer.impure.lisp
index 2c1247a..c478eb3 100644 (file)
--- a/tests/timer.impure.lisp
+++ b/tests/timer.impure.lisp
@@ -13,6 +13,18 @@
 
 (use-package :test-util)
 
+(with-test (:name :heap)
+  (let* ((size 1000)
+         (heap (make-array size :adjustable t :fill-pointer 0))
+         (unsorted (loop for i below size collect (random size)))
+         (sorted (sort (copy-list unsorted) #'>=))
+         heap-sorted)
+    (map nil #'(lambda (val) (sb-impl::heap-insert heap val)) unsorted)
+    (setf heap-sorted (loop for i below size
+                            collect (sb-impl::heap-extract-maximum heap)))
+    (unless (equal sorted heap-sorted)
+      (error "Heap sort failure ~S" heap-sorted))))
+
 (sb-alien:define-alien-routine "check_deferrables_blocked_or_lose"
     void
   (where sb-alien:unsigned-long))

diff --git a/version.lisp-expr b/version.lisp-expr
index f6e89d5..7bf1e02 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.27.1"
+"1.0.27.2"