trees, fix delete-at. Add testcase

diff --git a/extra/trees/trees-tests.factor b/extra/trees/trees-tests.factor
index 2172f9add03c0aa11b2c155f61ee5071ee843bb5..4660f5738ce9af6e94bbf50938358a4fa30140de 100644 (file)
--- a/extra/trees/trees-tests.factor
+++ b/extra/trees/trees-tests.factor
@@ -1,4 +1,5 @@
-USING: trees assocs tools.test kernel sequences ;
+USING: accessors assocs kernel namespaces random tools.test
+trees trees.private ;
 IN: trees.tests
 
 : test-tree ( -- tree )
@@ -55,3 +56,21 @@ IN: trees.tests
 ! test assoc-size
 { 3 } [ test-tree assoc-size ] unit-test
 { 2 } [ test-tree 9 over delete-at assoc-size ] unit-test
+
+TUPLE: constant-random pattern ;
+M: constant-random random-32* pattern>> ;
+{ T{ tree
+    { root
+        T{ node
+            { key 2 }
+            { value 2 }
+            { left  T{ node { key 0 } { value 0 } } }
+            { right T{ node { key 3 } { value 3 } } }
+        }
+    } { count 3 } }
+} [
+    TREE{ { 1 1 } { 3 3 } { 2 2 } { 0 0 } } clone
+    T{ constant-random f 0xffffffff } random-generator [
+        1 over delete-at
+    ] with-variable
+] unit-test

diff --git a/extra/trees/trees.factor b/extra/trees/trees.factor
index 8b3b41403322fd575e56fd1aff1e290cec5f1caf..82ac654582e565e618dd5de12300278579b295ca 100644 (file)
--- a/extra/trees/trees.factor
+++ b/extra/trees/trees.factor
@@ -148,7 +148,7 @@ DEFER: delete-node
     dup node-link [
         [ nip ] dip (prune-extremity)
     ] [
-        [ delete-node ] [ set-node-link ] bi
+        [ delete-node swap set-node-link ] keep
     ] if* ;
 
 : prune-extremity ( node -- new-extremity )