core/hashtables/hashtables-tests.factor

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