From 24de62e335420d84d6e52d999b65976e61a462ca Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 16 Nov 2007 00:17:34 -0500
Subject: [PATCH] Fix bug in delete-node

---
 core/dlists/dlists-tests.factor | 14 ++++++++++++++
 core/dlists/dlists.factor       | 11 +++++++----
 2 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/core/dlists/dlists-tests.factor b/core/dlists/dlists-tests.factor
index 7ac01a9070..ebae68472b 100755
--- a/core/dlists/dlists-tests.factor
+++ b/core/dlists/dlists-tests.factor
@@ -81,3 +81,17 @@ IN: temporary
         dlist>array
     ] 2keep seq-diff assert-same-elements
 ] unit-test
+
+[ ] [
+    <dlist> "d" set
+    1 "d" get push-front
+    2 "d" get push-front
+    3 "d" get push-front
+    4 "d" get push-front
+    2 "d" get dlist-delete drop
+    3 "d" get dlist-delete drop
+    4 "d" get dlist-delete drop
+] unit-test
+
+[ 1 ] [ "d" get dlist-length ] unit-test
+[ 1 ] [ "d" get dlist>array length ] unit-test
diff --git a/core/dlists/dlists.factor b/core/dlists/dlists.factor
index a48de4943a..a3c869efaf 100755
--- a/core/dlists/dlists.factor
+++ b/core/dlists/dlists.factor
@@ -103,12 +103,15 @@ PRIVATE>
 : dlist-contains? ( quot dlist -- ? )
     dlist-find nip ; inline
 
+: unlink-node ( dlist-node -- )
+    dup dlist-node-prev over dlist-node-next set-prev-when
+    dup dlist-node-next swap dlist-node-prev set-next-when ;
+
 : (delete-node) ( dlist dlist-node -- )
     {
-        { [ 2dup >r dlist-front r> = ] [ drop pop-front* ] }
-        { [ 2dup >r dlist-back r> = ] [ drop pop-back* ] }
-        { [ t ] [ dup dlist-node-prev swap dlist-node-next set-prev-when
-                  dec-length ] }
+        { [ over dlist-front over eq? ] [ drop pop-front* ] }
+        { [ over dlist-back over eq? ] [ drop pop-back* ] }
+        { [ t ] [ unlink-node dec-length ] }
     } cond ;
 
 : delete-node* ( quot dlist -- obj/f ? )