From 2cfa457258d93ea14a132a256fc96cf5c8d95c92 Mon Sep 17 00:00:00 2001
From: Samuel Tardieu <sam@rfc1149.net>
Date: Fri, 4 Jan 2019 16:15:45 +0100
Subject: [PATCH] Fix bugs in heap-delete

When an entry is kept to be use later with `heap-delete`, its `index`
in the owning heap is automatically updated as the entry sifts up
or down.

However, if the entry is removed from the heap via either a `heap-pop`
or a `heap-delete` operation, its index is not invalidated and
the entry can still be used later with `heap-delete` and remove the
wrong element from the heap.

This patch invalidates entries when they leave the heap by setting
their index to `f`, and check the index in `entry>index`.
---
 basis/heaps/heaps-tests.factor | 28 ++++++++++++++++++++++++++++
 basis/heaps/heaps.factor       |  9 +++++----
 2 files changed, 33 insertions(+), 4 deletions(-)

diff --git a/basis/heaps/heaps-tests.factor b/basis/heaps/heaps-tests.factor
index 49a0d31725..9a94eae642 100644
--- a/basis/heaps/heaps-tests.factor
+++ b/basis/heaps/heaps-tests.factor
@@ -79,3 +79,31 @@ IN: heaps.tests
 11 [
     [ t ] swap [ 2^ delete-test sequence= ] curry unit-test
 ] each-integer
+
+[| |
+ <min-heap> :> heap
+ t 1 heap heap-push* :> entry
+ heap heap-pop 2drop
+ t 2 heap heap-push
+ entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with
+
+[| |
+ <min-heap> :> heap
+ t 1 heap heap-push* :> entry
+ t 2 heap heap-push
+ heap heap-pop 2drop
+ entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with
+
+[| |
+ <min-heap> :> heap
+ t 1 heap heap-push* :> entry
+ t 2 heap heap-push
+ entry heap heap-delete
+ entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with
+
+[| |
+ <min-heap> :> heap
+ t 0 heap heap-push
+ t 1 heap heap-push* :> entry
+ entry heap heap-delete
+ entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with
diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor
index f4490fb620..ab8dc1d68f 100644
--- a/basis/heaps/heaps.factor
+++ b/basis/heaps/heaps.factor
@@ -131,9 +131,9 @@ PRIVATE>
 
 M: heap heap-pop*
     dup data>> dup length 1 > [
-        [ pop ] [ set-first ] bi 0 sift-up
+        [ first f >>index drop ] [ pop ] [ set-first ] tri 0 sift-up
     ] [
-        pop* drop
+        pop f >>index 2drop
     ] if ; inline
 
 : heap-pop ( heap -- value key )
@@ -156,12 +156,13 @@ M: bad-heap-delete summary
 
 : entry>index ( entry heap -- n )
     over heap>> eq? [ bad-heap-delete ] unless
-    index>> { fixnum } declare ; inline
+    index>> dup [ bad-heap-delete ] unless
+    { fixnum } declare ; inline
 
 PRIVATE>
 
 M: heap heap-delete
-    [ entry>index ] keep
+    [ entry>index ] [ f rot index<< ] 2bi
     2dup heap-size 1 - = [
         nip data>> pop*
     ] [