core/hashtables/hashtables-tests.factor

   1 USING: accessors assocs continuations fry hashtables kernel make
   2 math namespaces sequences slots.private tools.test ;
   3 IN: hashtables.tests
   4
   5 { H{ } } [ { } [ dup ] H{ } map>assoc ] unit-test
   6
   7 { } [ 1000 iota [ dup sq ] H{ } map>assoc "testhash" set ] unit-test
   8
   9 { V{ } }
  10 [ 1000 iota [ dup sq swap "testhash" get at = ] reject ]
  11 unit-test
  12
  13 { t }
  14 [ "testhash" get hashtable? ]
  15 unit-test
  16
  17 { f }
  18 [ { 1 { 2 3 } } hashtable? ]
  19 unit-test
  20
  21 { t } [
  22     "value" "key"
  23     [ associate ] [ H{ } clone [ set-at ] keep ] 2bi
  24     [ = ] [ [ array>> length ] bi@ = ] 2bi and
  25 ] unit-test
  26
  27 ! Test some hashcodes.
  28
  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
  31
  32 { t } [ 12 hashcode 12 hashcode = ] unit-test
  33 { t } [ 12 >bignum hashcode 12 hashcode = ] unit-test
  34
  35 ! Test various odd keys to see if they work.
  36
  37 16 <hashtable> "testhash" set
  38
  39 t { 2 3 } "testhash" get set-at
  40 f 100000000000000000000000000 "testhash" get set-at
  41 { } { [ { } ] } "testhash" get set-at
  42
  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
  46
  47 ! Regression
  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
  54
  55 {
  56     { "salmon" "fish" }
  57     { "crocodile" "reptile" }
  58     { "cow" "mammal" }
  59     { "visual basic" "language" }
  60 } >hashtable "testhash" set
  61
  62 { f f } [
  63     "visual basic" "testhash" get delete-at
  64     "visual basic" "testhash" get at*
  65 ] unit-test
  66
  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
  74
  75 ! Testing the hash element counting
  76
  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
  86
  87 ! Test rehashing
  88
  89 2 <hashtable> "rehash" set
  90
  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
  97
  98 { 6 } [ "rehash" get assoc-size ] unit-test
  99
 100 { 6 } [ "rehash" get clone assoc-size ] unit-test
 101
 102 "rehash" get clear-assoc
 103
 104 { 0 } [ "rehash" get assoc-size ] unit-test
 105
 106 {
 107     3
 108 } [
 109     2 H{
 110         { 1 2 }
 111         { 2 3 }
 112     } clone at
 113 ] unit-test
 114
 115 ! There was an assoc in place of assoc* somewhere
 116 3 <hashtable> "f-hash-test" set
 117
 118 10 [ f f "f-hash-test" get set-at ] times
 119
 120 { 1 } [ "f-hash-test" get assoc-size ] unit-test
 121
 122 ! Resource leak...
 123 H{ } "x" set
 124 100 [ drop "x" get clear-assoc ] each-integer
 125
 126 ! non-integer capacity not allowed
 127 [ 0.75 <hashtable> ] must-fail
 128
 129 ! Another crash discovered by erg
 130 { } [
 131     H{ } clone
 132     [ 1 swap set-at ] ignore-errors
 133     [ 2 swap set-at ] ignore-errors
 134     [ 3 swap set-at ] ignore-errors
 135     drop
 136 ] unit-test
 137
 138 { H{ { -1 4 } { -3 16 } { -5 36 } } } [
 139     H{ { 1 2 } { 3 4 } { 5 6 } }
 140     [ [ neg ] dip sq ] assoc-map
 141 ] unit-test
 142
 143 ! make sure growth and capacity use same load-factor
 144 { t } [
 145     100 iota
 146     [ [ <hashtable> ] map ]
 147     [ [ H{ } clone [ '[ dup _ set-at ] each-integer ] keep ] map ] bi
 148     [ [ array>> length ] bi@ = ] 2all?
 149 ] unit-test
 150
 151 ! Bug discovered by littledan
 152 { { 5 5 5 5 } } [
 153     [
 154         H{
 155             { 1 2 }
 156             { 2 3 }
 157             { 3 4 }
 158             { 4 5 }
 159             { 5 6 }
 160         } clone
 161         dup keys length ,
 162         dup assoc-size ,
 163         dup rehash
 164         dup keys length ,
 165         assoc-size ,
 166     ] { } make
 167 ] unit-test
 168
 169 { { "one" "two" 3 } } [
 170     { 1 2 3 } H{ { 1 "one" } { 2 "two" } } substitute
 171 ] unit-test
 172
 173 ! We want this to work
 174 { } [ hashtable new "h" set ] unit-test
 175
 176 { 0 } [ "h" get assoc-size ] unit-test
 177
 178 { f f } [ "goo" "h" get at* ] unit-test
 179
 180 { } [ 1 2 "h" get set-at ] unit-test
 181
 182 { 1 } [ "h" get assoc-size ] unit-test
 183
 184 { 1 } [ 2 "h" get at ] unit-test
 185
 186 ! Random test case
 187 { "A" } [ 100 iota [ dup ] H{ } map>assoc 32 over delete-at "A" 32 pick set-at 32 of ] unit-test