spacefrogg
/
critbit
1
0
Fork 0
Code Releases Activity

Write tests

master
Michael Raitza 2021-02-01 20:53:54 +01:00
parent c26dfad78d
commit b365f05b5d
2 changed files with 54 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
trees/cb/cb-tests.factor
View File

@ -1,13 +1,40 @@
USING: assocs kernel tools.test trees trees.cb trees.cb.private trees.private ;
IN: trees.cb.tests
CONSTANT: 4tree CB{ { 0 0 } { 1 1 } { 2 2 } { 3 3 } }
: 4tree ( -- tree )
CB{ { 0 0 } { 1 1 } { 2 2 } { 3 3 } } clone ;
! Insertion into an empty tree
{ CB{ { 0 0 } } } [
0 0 <cb> [ set-at ] keep
] unit-test
! Double inserts
! single leaf
{
CB{ { 0 0 } }
} [
0 0 <cb> [ set-at ] keep
0 0 rot [ set-at ] keep
] unit-test
! left leaf
{
CB{ { 0 0 } { 1 1 } }
} [
CB{ { 0 0 } { 1 1 } }
0 0 rot [ set-at ] keep
] unit-test
! right leaf
{
CB{ { 0 0 } { 1 1 } }
} [
CB{ { 0 0 } { 1 1 } }
1 1 rot [ set-at ] keep
] unit-test
! Splits
! Insertion into a leaf-node resulting in splitting
{
CB{ { 0 0 } { 1 1 } }
@ -15,3 +42,25 @@ CONSTANT: 4tree CB{ { 0 0 } { 1 1 } { 2 2 } { 3 3 } }
0 0 <cb> [ set-at ] keep
1 1 rot [ set-at ] keep
] unit-test
! Splitting at the root
{
CB{ { 0 0 } { 1 1 } { 2 2 } { 3 3 } { 4 4 } }
} [
CB{ { 0 0 } { 1 1 } { 2 2 } { 3 3 } }
4 4 rot [ set-at ] keep
] unit-test
! Collision
{
CB{ { B{ 110 } B{ 110 } } }
} [
CB{ { f f } }
B{ 110 } dup rot [ set-at ] keep
] unit-test
! Colliding trees are still not equal
{ f } [
CB{ { f f } }
CB{ { B{ 110 } B{ 110 } } } =
] unit-test

12
trees/cb/cb.factor
View File

@ -34,8 +34,8 @@ TUPLE: cb-node { byte# integer } { bits fixnum } left right ;
swap >>bits
swap >>byte# ; inline
: <cb-node> ( byte# bits -- node )
cb-node new-node ;
: <cb-node> ( bits byte# -- node )
swap cb-node new-node ;
: key-side ( bits byte -- side )
bitor 1 + -8 shift 0 = left right ? ;
@ -67,12 +67,8 @@ TUPLE: cb-node { byte# integer } { bits fixnum } left right ;
[
[ -rot 2nth-unsafe byte-diff ] keep
] [
! [ [ length ] bi@ = ] 2keep rot
! [ 2drop 0 0 f ]
! [
[ min-length dup ] 2keep
2nth0 byte-diff rot
! ] if
] if* ;
PRIVATE>
@ -159,8 +155,8 @@ M: node cb-update
current-key get >>key
swap >>value f
] [
key>> key>bytes key-bytes get swap
bytes-diff swap <cb-node>
[ key-bytes get ] dip key>> key>bytes
bytes-diff <cb-node>
attach-node t
] if ;