[Sbcl-commits] CVS: sbcl/tests timer.impure.lisp,1.16,1.17

[Gabor M. <me...@us...>]

Update of /cvsroot/sbcl/sbcl/tests
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv9359/tests

Modified Files:
	timer.impure.lisp 
Log Message:
1.0.27.2: fix bug in heap implementation

... used by timers.

Thanks to Ole Arndt for the patch.


Index: timer.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/timer.impure.lisp,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -d -r1.16 -r1.17
--- timer.impure.lisp	22 Mar 2009 21:44:07 -0000	1.16
+++ timer.impure.lisp	6 Apr 2009 08:54:27 -0000	1.17
@@ -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))