1 USING: accessors assocs continuations hashtables io kernel make
2 math namespaces prettyprint sequences sequences.private
6 [ H{ } ] [ { } [ dup ] H{ } map>assoc ] unit-test
8 [ ] [ 1000 iota [ dup sq ] H{ } map>assoc "testhash" set ] unit-test
11 [ 1000 iota [ dup sq swap "testhash" get at = not ] filter ]
15 [ "testhash" get hashtable? ]
19 [ { 1 { 2 3 } } hashtable? ]
24 [ associate ] [ H{ } clone [ set-at ] keep ] 2bi
25 [ = ] [ [ array>> length ] bi@ = ] 2bi and
28 ! Test some hashcodes.
30 [ t ] [ [ 1 2 3 ] hashcode [ 1 2 3 ] hashcode = ] unit-test
31 [ t ] [ [ 1 [ 2 3 ] 4 ] hashcode [ 1 [ 2 3 ] 4 ] hashcode = ] unit-test
33 [ t ] [ 12 hashcode 12 hashcode = ] unit-test
34 [ t ] [ 12 >bignum hashcode 12 hashcode = ] unit-test
36 ! Test various odd keys to see if they work.
38 16 <hashtable> "testhash" set
40 t { 2 3 } "testhash" get set-at
41 f 100000000000000000000000000 "testhash" get set-at
42 { } { [ { } ] } "testhash" get set-at
44 [ t ] [ { 2 3 } "testhash" get at ] unit-test
45 [ f ] [ 100000000000000000000000000 "testhash" get at* drop ] unit-test
46 [ { } ] [ { [ { } ] } clone "testhash" get at* drop ] unit-test
49 3 <hashtable> "broken-remove" set
50 1 W{ \ + } dup "x" set "broken-remove" get set-at
51 2 W{ \ = } dup "y" set "broken-remove" get set-at
52 "x" get "broken-remove" get delete-at
53 2 "y" get "broken-remove" get set-at
54 [ 1 ] [ "broken-remove" get keys length ] unit-test
58 { "crocodile" "reptile" }
60 { "visual basic" "language" }
61 } >hashtable "testhash" set
64 "visual basic" "testhash" get delete-at
65 "visual basic" "testhash" get at*
68 [ t ] [ H{ } dup = ] unit-test
69 [ f ] [ "xyz" H{ } = ] unit-test
70 [ t ] [ H{ } H{ } = ] unit-test
71 [ f ] [ H{ { 1 3 } } H{ } = ] unit-test
72 [ f ] [ H{ } H{ { 1 3 } } = ] unit-test
73 [ t ] [ H{ { 1 3 } } H{ { 1 3 } } = ] unit-test
74 [ f ] [ H{ { 1 3 } } H{ { 1 "hey" } } = ] unit-test
76 ! Testing the hash element counting
78 H{ } clone "counting" set
79 "value" "key" "counting" get set-at
80 [ 1 ] [ "counting" get assoc-size ] unit-test
81 "value" "key" "counting" get set-at
82 [ 1 ] [ "counting" get assoc-size ] unit-test
83 "key" "counting" get delete-at
84 [ 0 ] [ "counting" get assoc-size ] unit-test
85 "key" "counting" get delete-at
86 [ 0 ] [ "counting" get assoc-size ] unit-test
90 2 <hashtable> "rehash" set
92 1 1 "rehash" get set-at
93 2 2 "rehash" get set-at
94 3 3 "rehash" get set-at
95 4 4 "rehash" get set-at
96 5 5 "rehash" get set-at
97 6 6 "rehash" get set-at
99 [ 6 ] [ "rehash" get assoc-size ] unit-test
101 [ 6 ] [ "rehash" get clone assoc-size ] unit-test
103 "rehash" get clear-assoc
105 [ 0 ] [ "rehash" get assoc-size ] unit-test
116 ! There was an assoc in place of assoc* somewhere
117 3 <hashtable> "f-hash-test" set
119 10 [ f f "f-hash-test" get set-at ] times
121 [ 1 ] [ "f-hash-test" get assoc-size ] unit-test
125 100 [ drop "x" get clear-assoc ] each-integer
127 ! Crash discovered by erg
128 [ t ] [ 0.75 <hashtable> dup clone = ] unit-test
130 ! Another crash discovered by erg
133 [ 1 swap set-at ] ignore-errors
134 [ 2 swap set-at ] ignore-errors
135 [ 3 swap set-at ] ignore-errors
139 [ H{ { -1 4 } { -3 16 } { -5 36 } } ] [
140 H{ { 1 2 } { 3 4 } { 5 6 } }
141 [ [ neg ] dip sq ] assoc-map
144 ! Bug discovered by littledan
162 [ { "one" "two" 3 } ] [
163 { 1 2 3 } H{ { 1 "one" } { 2 "two" } } substitute
166 ! We want this to work
167 [ ] [ hashtable new "h" set ] unit-test
169 [ 0 ] [ "h" get assoc-size ] unit-test
171 [ f f ] [ "goo" "h" get at* ] unit-test
173 [ ] [ 1 2 "h" get set-at ] unit-test
175 [ 1 ] [ "h" get assoc-size ] unit-test
177 [ 1 ] [ 2 "h" get at ] unit-test
180 [ "A" ] [ 100 iota [ dup ] H{ } map>assoc 32 over delete-at "A" 32 pick set-at 32 of ] unit-test