core/hashtables/hashtables-tests.factor

   1 USING: kernel math namespaces make tools.test vectors sequences
   2 sequences.private hashtables io prettyprint assocs
   3 continuations ;
   4 IN: hashtables.tests
   5
   6 [ f ] [ "hi" V{ 1 2 3 } at ] unit-test
   7
   8 [ H{ } ] [ { } [ dup ] H{ } map>assoc ] unit-test
   9
  10 [ ] [ 1000 [ dup sq ] H{ } map>assoc "testhash" set ] unit-test
  11
  12 [ V{ } ]
  13 [ 1000 [ dup sq swap "testhash" get at = not ] filter ]
  14 unit-test
  15
  16 [ t ]
  17 [ "testhash" get hashtable? ]
  18 unit-test
  19
  20 [ f ]
  21 [ { 1 { 2 3 } } hashtable? ]
  22 unit-test
  23
  24 ! Test some hashcodes.
  25
  26 [ t ] [ [ 1 2 3 ] hashcode [ 1 2 3 ] hashcode = ] unit-test
  27 [ t ] [ [ 1 [ 2 3 ] 4 ] hashcode [ 1 [ 2 3 ] 4 ] hashcode = ] unit-test
  28
  29 [ t ] [ 12 hashcode 12 hashcode = ] unit-test
  30 [ t ] [ 12 >bignum hashcode 12 hashcode = ] unit-test
  31
  32 ! Test various odd keys to see if they work.
  33
  34 16 <hashtable> "testhash" set
  35
  36 t { 2 3 } "testhash" get set-at
  37 f 100000000000000000000000000 "testhash" get set-at
  38 { } { [ { } ] } "testhash" get set-at
  39
  40 [ t ] [ { 2 3 } "testhash" get at ] unit-test
  41 [ f ] [ 100000000000000000000000000 "testhash" get at* drop ] unit-test
  42 [ { } ] [ { [ { } ] } clone "testhash" get at* drop ] unit-test
  43
  44 ! Regression
  45 3 <hashtable> "broken-remove" set
  46 1 W{ \ + } dup "x" set "broken-remove" get set-at
  47 2 W{ \ = } dup "y" set "broken-remove" get set-at
  48 "x" get "broken-remove" get delete-at
  49 2 "y" get "broken-remove" get set-at
  50 [ 1 ] [ "broken-remove" get keys length ] unit-test
  51
  52 {
  53     { "salmon" "fish" }
  54     { "crocodile" "reptile" }
  55     { "cow" "mammal" }
  56     { "visual basic" "language" }
  57 } >hashtable "testhash" set
  58
  59 [ f f ] [
  60     "visual basic" "testhash" get delete-at
  61     "visual basic" "testhash" get at*
  62 ] unit-test
  63
  64 [ t ] [ H{ } dup = ] unit-test
  65 [ f ] [ "xyz" H{ } = ] unit-test
  66 [ t ] [ H{ } H{ } = ] unit-test
  67 [ f ] [ H{ { 1 3 } } H{ } = ] unit-test
  68 [ f ] [ H{ } H{ { 1 3 } } = ] unit-test
  69 [ t ] [ H{ { 1 3 } } H{ { 1 3 } } = ] unit-test
  70 [ f ] [ H{ { 1 3 } } H{ { 1 "hey" } } = ] unit-test
  71
  72 ! Testing the hash element counting
  73
  74 H{ } clone "counting" set
  75 "value" "key" "counting" get set-at
  76 [ 1 ] [ "counting" get assoc-size ] unit-test
  77 "value" "key" "counting" get set-at
  78 [ 1 ] [ "counting" get assoc-size ] unit-test
  79 "key" "counting" get delete-at
  80 [ 0 ] [ "counting" get assoc-size ] unit-test
  81 "key" "counting" get delete-at
  82 [ 0 ] [ "counting" get assoc-size ] unit-test
  83
  84 ! Test rehashing
  85
  86 2 <hashtable> "rehash" set
  87
  88 1 1 "rehash" get set-at
  89 2 2 "rehash" get set-at
  90 3 3 "rehash" get set-at
  91 4 4 "rehash" get set-at
  92 5 5 "rehash" get set-at
  93 6 6 "rehash" get set-at
  94
  95 [ 6 ] [ "rehash" get assoc-size ] unit-test
  96
  97 [ 6 ] [ "rehash" get clone assoc-size ] unit-test
  98
  99 "rehash" get clear-assoc
 100
 101 [ 0 ] [ "rehash" get assoc-size ] unit-test
 102
 103 [
 104     3
 105 ] [
 106     2 H{
 107         { 1 2 }
 108         { 2 3 }
 109     } clone at
 110 ] unit-test
 111
 112 ! There was an assoc in place of assoc* somewhere
 113 3 <hashtable> "f-hash-test" set
 114
 115 10 [ f f "f-hash-test" get set-at ] times
 116
 117 [ 1 ] [ "f-hash-test" get assoc-size ] unit-test
 118
 119 ! Resource leak...
 120 H{ } "x" set
 121 100 [ drop "x" get clear-assoc ] each
 122
 123 ! Crash discovered by erg
 124 [ t ] [ 0.75 <hashtable> dup clone = ] unit-test
 125
 126 ! Another crash discovered by erg
 127 [ ] [
 128     H{ } clone
 129     [ 1 swap set-at ] ignore-errors
 130     [ 2 swap set-at ] ignore-errors
 131     [ 3 swap set-at ] ignore-errors
 132     drop
 133 ] unit-test
 134
 135 [ H{ { -1 4 } { -3 16 } { -5 36 } } ] [
 136     H{ { 1 2 } { 3 4 } { 5 6 } }
 137     [ [ neg ] dip sq ] assoc-map
 138 ] unit-test
 139
 140 ! Bug discovered by littledan
 141 [ { 5 5 5 5 } ] [
 142     [
 143         H{
 144             { 1 2 }
 145             { 2 3 }
 146             { 3 4 }
 147             { 4 5 }
 148             { 5 6 }
 149         } clone
 150         dup keys length ,
 151         dup assoc-size ,
 152         dup rehash
 153         dup keys length ,
 154         assoc-size ,
 155     ] { } make
 156 ] unit-test
 157
 158 [ { "one" "two" 3 } ] [
 159     { 1 2 3 } clone dup
 160     H{ { 1 "one" } { 2 "two" } } substitute-here
 161 ] unit-test
 162
 163 [ { "one" "two" 3 } ] [
 164     { 1 2 3 } H{ { 1 "one" } { 2 "two" } } substitute
 165 ] unit-test
 166
 167 ! We want this to work
 168 [ ] [ hashtable new "h" set ] unit-test
 169
 170 [ 0 ] [ "h" get assoc-size ] unit-test
 171
 172 [ f f ] [ "goo" "h" get at* ] unit-test
 173
 174 [ ] [ 1 2 "h" get set-at ] unit-test
 175
 176 [ 1 ] [ "h" get assoc-size ] unit-test
 177
 178 [ 1 ] [ 2 "h" get at ] unit-test
 179
 180 ! Random test case
 181 [ "A" ] [ 100 [ dup ] H{ } map>assoc 32 over delete-at "A" 32 pick set-at 32 swap at ] unit-test