trees.avl: fix it (broken since 2010)

rotate creates cycles in the tree and drops nodes...
This either breaks everything (infinite recursion) or silently
loses data.

Improve the tests to ensure rotate does what it's supposed to do.

This is a partial revert from 15226d8

diff --git a/extra/trees/avl/avl-tests.factor b/extra/trees/avl/avl-tests.factor
index 5491da3ae59ca4ae460b7c3f7e195eb0d2f3c318..9b9ec8ea5b0119aac6af6f6b626b1fbff6fa3526 100644 (file)
--- a/extra/trees/avl/avl-tests.factor
+++ b/extra/trees/avl/avl-tests.factor
@@ -2,31 +2,35 @@ USING: kernel tools.test trees trees.avl math random sequences
 assocs accessors trees.avl.private trees.private ;
 IN: trees.avl.tests
 
-{ "key1" 0 "key2" 0 } [
-    T{ avl-node f "key1" f f T{ avl-node f "key2" f f f 1 } 2 }
+{ "key1" 0 "key3" "key2" 0 } [
+    T{ avl-node f "key1" f f T{ avl-node f "key2" f T{ avl-node f "key3" } f 1 } 2 }
     [ single-rotate ] go-left
     [ left>> dup key>> swap balance>> ] keep
+    [ left>> right>> key>> ] keep
     dup key>> swap balance>>
 ] unit-test
 
-{ "key1" 0 "key2" 0 } [
-    T{ avl-node f "key1" f f T{ avl-node f "key2" f f f 1 } 2 }
+{ "key1" 0 "key3" "key2" 0 } [
+    T{ avl-node f "key1" f f T{ avl-node f "key2" f T{ avl-node f "key3" } f 1 } 2 }
     [ select-rotate ] go-left
     [ left>> dup key>> swap balance>> ] keep
+    [ left>> right>> key>> ] keep
     dup key>> swap balance>>
 ] unit-test
 
-{ "key1" 0 "key2" 0 } [
-    T{ avl-node f "key1" f T{ avl-node f "key2" f f f -1 } f -2 }
+{ "key1" 0 "key3" "key2" 0 } [
+    T{ avl-node f "key1" f T{ avl-node f "key2" f f T{ avl-node f "key3" } -1 } f -2 }
     [ single-rotate ] go-right
     [ right>> dup key>> swap balance>> ] keep
+    [ right>> left>> key>> ] keep
     dup key>> swap balance>>
 ] unit-test
 
-{ "key1" 0 "key2" 0 } [
-    T{ avl-node f "key1" f T{ avl-node f "key2" f f f -1 } f -2 }
+{ "key1" 0 "key3" "key2" 0 } [
+    T{ avl-node f "key1" f T{ avl-node f "key2" f f T{ avl-node f "key3" } -1 } f -2 }
     [ select-rotate ] go-right
     [ right>> dup key>> swap balance>> ] keep
+    [ right>> left>> key>> ] keep
     dup key>> swap balance>>
 ] unit-test
 

diff --git a/extra/trees/avl/avl.factor b/extra/trees/avl/avl.factor
index 5e670abe1f22fe56a1077e4ad4ec974497d40aea..dacc21346abe9ded8a3bc3aabb6df7b0ba8bdc33 100644 (file)
--- a/extra/trees/avl/avl.factor
+++ b/extra/trees/avl/avl.factor
@@ -23,10 +23,9 @@ TUPLE: avl-node < node balance ;
     '[ _ + ] change-balance ;
 
 : rotate ( node -- node )
-    dup
-    [ node+link ]
-    [ node-link ]
-    [ set-node+link ] tri
+    dup node+link
+    dup node-link
+    pick set-node+link
     [ set-node-link ] keep ;
 
 : single-rotate ( node -- node )