From 3d60f7ad5a11dcc37ebb744a7ff96b2b2b5ee1ec Mon Sep 17 00:00:00 2001
From: Jon Harper <jon.harper87@gmail.com>
Date: Sun, 27 Nov 2016 14:49:35 +0100
Subject: [PATCH] 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
---
 extra/trees/avl/avl-tests.factor | 20 ++++++++++++--------
 extra/trees/avl/avl.factor       |  7 +++----
 2 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/extra/trees/avl/avl-tests.factor b/extra/trees/avl/avl-tests.factor
index 5491da3ae5..9b9ec8ea5b 100644
--- 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 5e670abe1f..dacc21346a 100644
--- 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 )