another boundary bug in %HEAP-DELETE.

  Deleting the last element of a heap vector requires no fixing
  up.

  Add tests for basic boundary cases of HEAP-HELETE.

pileup.lisp

@@ -337,23 +337,28 @@ holding the heap lock via WITH-LOCKED-HEAP."
                                 (aref vector local) parent-data
                                 parent local
                                 recoverable nil))))
-           (if (= index 1)
-               ;; Deleted the topmost element: copy it to V[0]
-               (setf (aref vector 0) (aref vector 1))
-               ;; Deleted something from middle: fix heap property
-               ;; towards the head.
-               (loop with child = index
-                     while (> child 1)
-                     do (let* ((parent (truncate child 2))
-                               (parent-data (aref vector parent))
-                               (child-data (aref vector child)))
-                          (cond ((funcall fast-pred parent-data child-data)
-                                 (return))
-                                (t
-                                 (setf (aref vector child) parent-data
-                                       (aref vector parent) child-data
-                                       child parent
-                                       recoverable nil))))))
+           ;; Step 2: fix towards the head.
+           (cond ((= index 1)
+                  ;; Deleted the topmost element: copy it to V[0]
+                  (setf (aref vector 0) (aref vector 1)))
+                 ((= index (1+ count))
+                  ;; Deleted the last element: nothing to do.
+                  )
+                 (t
+                  ;; Deleted something from middle: fix heap property
+                  ;; towards the head.
+                  (loop with child = index
+                        while (> child 1)
+                        do (let* ((parent (truncate child 2))
+                                  (parent-data (aref vector parent))
+                                  (child-data (aref vector child)))
+                             (cond ((funcall fast-pred parent-data child-data)
+                                    (return))
+                                   (t
+                                    (setf (aref vector child) parent-data
+                                          (aref vector parent) child-data
+                                          child parent
+                                          recoverable nil)))))))
            ;; Clean again
            (setf (heap-state heap) :clean))
       ;; If we're not clean, try to recover on unwind.

tests.lisp

@@ -173,6 +173,29 @@
     (is (= 100 (heap-pop heap)))
     (is (heap-empty-p heap))))
 
+(deftest delete-boundary-cases ()
+  (let ((heap (make-heap #'<)))
+    ;; No elements
+    (is (not (heap-delete 0 heap)))
+    (is (heap-empty-p heap))
+    ;; One element
+    (heap-insert 0 heap)
+    (is (heap-delete 0 heap))
+    (is (heap-empty-p heap))
+    ;; Two elements, first
+    (heap-insert 0 heap)
+    (heap-insert 1 heap)
+    (is (= 0 (heap-top heap)))
+    (is (heap-delete 0 heap))
+    (is (= 1 (heap-count heap)))
+    (is (= 1 (heap-top heap)))
+    ;; Two elements, last
+    (heap-insert 0 heap)
+    (is (= 0 (heap-top heap)))
+    (is (heap-delete 1 heap))
+    (is (= 1 (heap-count heap)))
+    (is (= 0 (heap-top heap)))))
+
 #+sbcl
 (deftest slot-names-nice ()
   (let ((pileup (find-package :pileup)))