From 0ef46b423413b918255fa59e951c6aeef5f93de4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 15 Nov 2007 21:44:10 -0500
Subject: [PATCH] Some dlists unit tests added

---
 core/dlists/dlists-tests.factor | 24 +++++++++++++++++++++++-
 core/dlists/dlists.factor       |  3 +++
 2 files changed, 26 insertions(+), 1 deletion(-)
 mode change 100644 => 100755 core/dlists/dlists-tests.factor

diff --git a/core/dlists/dlists-tests.factor b/core/dlists/dlists-tests.factor
old mode 100644
new mode 100755
index f4482d680d..7ac01a9070
--- a/core/dlists/dlists-tests.factor
+++ b/core/dlists/dlists-tests.factor
@@ -1,4 +1,6 @@
-USING: dlists dlists.private kernel tools.test ;
+USING: dlists dlists.private kernel tools.test random assocs
+hashtables sequences namespaces sorting debugger io prettyprint
+math ;
 IN: temporary
 
 [ t ] [ <dlist> dlist-empty? ] unit-test
@@ -59,3 +61,23 @@ IN: temporary
 [ 0 ] [ <dlist> dlist-length ] unit-test
 [ 1 ] [ <dlist> 1 over push-front dlist-length ] unit-test
 [ 0 ] [ <dlist> 1 over push-front dup pop-front* dlist-length ] unit-test
+
+: assert-same-elements
+    [ prune natural-sort ] 2apply assert= ;
+
+: dlist-push-all [ push-front ] curry each ;
+
+: dlist-delete-all [ dlist-delete drop ] curry each ;
+
+: dlist>array [ [ , ] dlist-slurp ] { } make ;
+
+[ ] [
+    5 [ drop 30 random >fixnum ] map prune
+    6 [ drop 30 random >fixnum ] map prune 2dup nl . . nl
+    [
+        <dlist>
+        [ dlist-push-all ] keep
+        [ dlist-delete-all ] keep
+        dlist>array
+    ] 2keep seq-diff assert-same-elements
+] unit-test
diff --git a/core/dlists/dlists.factor b/core/dlists/dlists.factor
index cc6a8b3699..a48de4943a 100755
--- a/core/dlists/dlists.factor
+++ b/core/dlists/dlists.factor
@@ -121,6 +121,9 @@ PRIVATE>
 : delete-node ( quot dlist -- obj/f )
     delete-node* drop ; inline
 
+: dlist-delete ( obj dlist -- obj/f )
+    >r [ eq? ] curry r> delete-node ;
+
 : dlist-each ( dlist quot -- )
     [ dlist-node-obj ] swap compose dlist-each-node ; inline