1 USING: accessors assocs continuations fry hashtables kernel make
2 math namespaces sequences slots.private tools.test ;
5 { H{ } } [ { } [ dup ] H{ } map>assoc ] unit-test
7 { } [ 1000 iota [ dup sq ] H{ } map>assoc "testhash" set ] unit-test
10 [ 1000 iota [ dup sq swap "testhash" get at = ] reject ]
14 [ "testhash" get hashtable? ]
18 [ { 1 { 2 3 } } hashtable? ]
23 [ associate ] [ H{ } clone [ set-at ] keep ] 2bi
24 [ = ] [ [ array>> length ] bi@ = ] 2bi and
27 ! Test some hashcodes.
29 { t } [ [ 1 2 3 ] hashcode [ 1 2 3 ] hashcode = ] unit-test
30 { t } [ [ 1 [ 2 3 ] 4 ] hashcode [ 1 [ 2 3 ] 4 ] hashcode = ] unit-test
32 { t } [ 12 hashcode 12 hashcode = ] unit-test
33 { t } [ 12 >bignum hashcode 12 hashcode = ] unit-test
35 ! Test various odd keys to see if they work.
37 16 <hashtable> "testhash" set
39 t { 2 3 } "testhash" get set-at
40 f 100000000000000000000000000 "testhash" get set-at
41 { } { [ { } ] } "testhash" get set-at
43 { t } [ { 2 3 } "testhash" get at ] unit-test
44 { f } [ 100000000000000000000000000 "testhash" get at* drop ] unit-test
45 { { } } [ { [ { } ] } clone "testhash" get at* drop ] unit-test
48 3 <hashtable> "broken-remove" set
49 1 W{ \ + } dup "x" set "broken-remove" get set-at
50 2 W{ \ = } dup "y" set "broken-remove" get set-at
51 "x" get "broken-remove" get delete-at
52 2 "y" get "broken-remove" get set-at
53 { 1 } [ "broken-remove" get keys length ] unit-test
57 { "crocodile" "reptile" }
59 { "visual basic" "language" }
60 } >hashtable "testhash" set
63 "visual basic" "testhash" get delete-at
64 "visual basic" "testhash" get at*
67 { t } [ H{ } dup = ] unit-test
68 { f } [ "xyz" H{ } = ] unit-test
69 { t } [ H{ } H{ } = ] unit-test
70 { f } [ H{ { 1 3 } } H{ } = ] unit-test
71 { f } [ H{ } H{ { 1 3 } } = ] unit-test
72 { t } [ H{ { 1 3 } } H{ { 1 3 } } = ] unit-test
73 { f } [ H{ { 1 3 } } H{ { 1 "hey" } } = ] unit-test
75 ! Testing the hash element counting
77 H{ } clone "counting" set
78 "value" "key" "counting" get set-at
79 { 1 } [ "counting" get assoc-size ] unit-test
80 "value" "key" "counting" get set-at
81 { 1 } [ "counting" get assoc-size ] unit-test
82 "key" "counting" get delete-at
83 { 0 } [ "counting" get assoc-size ] unit-test
84 "key" "counting" get delete-at
85 { 0 } [ "counting" get assoc-size ] unit-test
89 2 <hashtable> "rehash" set
91 1 1 "rehash" get set-at
92 2 2 "rehash" get set-at
93 3 3 "rehash" get set-at
94 4 4 "rehash" get set-at
95 5 5 "rehash" get set-at
96 6 6 "rehash" get set-at
98 { 6 } [ "rehash" get assoc-size ] unit-test
100 { 6 } [ "rehash" get clone assoc-size ] unit-test
102 "rehash" get clear-assoc
104 { 0 } [ "rehash" get assoc-size ] unit-test
115 ! There was an assoc in place of assoc* somewhere
116 3 <hashtable> "f-hash-test" set
118 10 [ f f "f-hash-test" get set-at ] times
120 { 1 } [ "f-hash-test" get assoc-size ] unit-test
124 100 [ drop "x" get clear-assoc ] each-integer
126 ! non-integer capacity not allowed
127 [ 0.75 <hashtable> ] must-fail
129 ! Another crash discovered by erg
132 [ 1 swap set-at ] ignore-errors
133 [ 2 swap set-at ] ignore-errors
134 [ 3 swap set-at ] ignore-errors
138 { H{ { -1 4 } { -3 16 } { -5 36 } } } [
139 H{ { 1 2 } { 3 4 } { 5 6 } }
140 [ [ neg ] dip sq ] assoc-map
143 ! make sure growth and capacity use same load-factor
146 [ [ <hashtable> ] map ]
147 [ [ H{ } clone [ '[ dup _ set-at ] each-integer ] keep ] map ] bi
148 [ [ array>> length ] bi@ = ] 2all?
151 ! Bug discovered by littledan
169 { { "one" "two" 3 } } [
170 { 1 2 3 } H{ { 1 "one" } { 2 "two" } } substitute
173 ! We want this to work
174 { } [ hashtable new "h" set ] unit-test
176 { 0 } [ "h" get assoc-size ] unit-test
178 { f f } [ "goo" "h" get at* ] unit-test
180 { } [ 1 2 "h" get set-at ] unit-test
182 { 1 } [ "h" get assoc-size ] unit-test
184 { 1 } [ 2 "h" get at ] unit-test
187 { "A" } [ 100 iota [ dup ] H{ } map>assoc 32 over delete-at "A" 32 pick set-at 32 of ] unit-test
189 ! Bug 1392, word's hashcode was declared a fixnum
190 ! It fails depending on hash growth, so test in a loop
191 SYMBOL: +bignum-hashcode+
192 -405534154 +bignum-hashcode+ 1 set-slot
197 f +bignum-hashcode+ pick set-at
198 +bignum-hashcode+ +bignum-hashcode+ pick set-at assoc-size 1 =