1 USING: kernel math namespaces make tools.test vectors sequences
2 sequences.private hashtables io prettyprint assocs
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? ]
22 ! Test some hashcodes.
24 [ t ] [ [ 1 2 3 ] hashcode [ 1 2 3 ] hashcode = ] unit-test
25 [ t ] [ [ 1 [ 2 3 ] 4 ] hashcode [ 1 [ 2 3 ] 4 ] hashcode = ] unit-test
27 [ t ] [ 12 hashcode 12 hashcode = ] unit-test
28 [ t ] [ 12 >bignum hashcode 12 hashcode = ] unit-test
30 ! Test various odd keys to see if they work.
32 16 <hashtable> "testhash" set
34 t { 2 3 } "testhash" get set-at
35 f 100000000000000000000000000 "testhash" get set-at
36 { } { [ { } ] } "testhash" get set-at
38 [ t ] [ { 2 3 } "testhash" get at ] unit-test
39 [ f ] [ 100000000000000000000000000 "testhash" get at* drop ] unit-test
40 [ { } ] [ { [ { } ] } clone "testhash" get at* drop ] unit-test
43 3 <hashtable> "broken-remove" set
44 1 W{ \ + } dup "x" set "broken-remove" get set-at
45 2 W{ \ = } dup "y" set "broken-remove" get set-at
46 "x" get "broken-remove" get delete-at
47 2 "y" get "broken-remove" get set-at
48 [ 1 ] [ "broken-remove" get keys length ] unit-test
52 { "crocodile" "reptile" }
54 { "visual basic" "language" }
55 } >hashtable "testhash" set
58 "visual basic" "testhash" get delete-at
59 "visual basic" "testhash" get at*
62 [ t ] [ H{ } dup = ] unit-test
63 [ f ] [ "xyz" H{ } = ] unit-test
64 [ t ] [ H{ } H{ } = ] unit-test
65 [ f ] [ H{ { 1 3 } } H{ } = ] unit-test
66 [ f ] [ H{ } H{ { 1 3 } } = ] unit-test
67 [ t ] [ H{ { 1 3 } } H{ { 1 3 } } = ] unit-test
68 [ f ] [ H{ { 1 3 } } H{ { 1 "hey" } } = ] unit-test
70 ! Testing the hash element counting
72 H{ } clone "counting" set
73 "value" "key" "counting" get set-at
74 [ 1 ] [ "counting" get assoc-size ] unit-test
75 "value" "key" "counting" get set-at
76 [ 1 ] [ "counting" get assoc-size ] unit-test
77 "key" "counting" get delete-at
78 [ 0 ] [ "counting" get assoc-size ] unit-test
79 "key" "counting" get delete-at
80 [ 0 ] [ "counting" get assoc-size ] unit-test
84 2 <hashtable> "rehash" set
86 1 1 "rehash" get set-at
87 2 2 "rehash" get set-at
88 3 3 "rehash" get set-at
89 4 4 "rehash" get set-at
90 5 5 "rehash" get set-at
91 6 6 "rehash" get set-at
93 [ 6 ] [ "rehash" get assoc-size ] unit-test
95 [ 6 ] [ "rehash" get clone assoc-size ] unit-test
97 "rehash" get clear-assoc
99 [ 0 ] [ "rehash" get assoc-size ] unit-test
110 ! There was an assoc in place of assoc* somewhere
111 3 <hashtable> "f-hash-test" set
113 10 [ f f "f-hash-test" get set-at ] times
115 [ 1 ] [ "f-hash-test" get assoc-size ] unit-test
119 100 [ drop "x" get clear-assoc ] each-integer
121 ! Crash discovered by erg
122 [ t ] [ 0.75 <hashtable> dup clone = ] unit-test
124 ! Another crash discovered by erg
127 [ 1 swap set-at ] ignore-errors
128 [ 2 swap set-at ] ignore-errors
129 [ 3 swap set-at ] ignore-errors
133 [ H{ { -1 4 } { -3 16 } { -5 36 } } ] [
134 H{ { 1 2 } { 3 4 } { 5 6 } }
135 [ [ neg ] dip sq ] assoc-map
138 ! Bug discovered by littledan
156 [ { "one" "two" 3 } ] [
157 { 1 2 3 } H{ { 1 "one" } { 2 "two" } } substitute
160 ! We want this to work
161 [ ] [ hashtable new "h" set ] unit-test
163 [ 0 ] [ "h" get assoc-size ] unit-test
165 [ f f ] [ "goo" "h" get at* ] unit-test
167 [ ] [ 1 2 "h" get set-at ] unit-test
169 [ 1 ] [ "h" get assoc-size ] unit-test
171 [ 1 ] [ 2 "h" get at ] unit-test
174 [ "A" ] [ 100 iota [ dup ] H{ } map>assoc 32 over delete-at "A" 32 pick set-at 32 swap at ] unit-test