core/hashtables/hashtables-tests.factor

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