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 [ 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 ! Test some hashcodes.
  23
  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
  26
  27 [ t ] [ 12 hashcode 12 hashcode = ] unit-test
  28 [ t ] [ 12 >bignum hashcode 12 hashcode = ] unit-test
  29
  30 ! Test various odd keys to see if they work.
  31
  32 16 <hashtable> "testhash" set
  33
  34 t { 2 3 } "testhash" get set-at
  35 f 100000000000000000000000000 "testhash" get set-at
  36 { } { [ { } ] } "testhash" get set-at
  37
  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
  41
  42 ! Regression
  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
  49
  50 {
  51     { "salmon" "fish" }
  52     { "crocodile" "reptile" }
  53     { "cow" "mammal" }
  54     { "visual basic" "language" }
  55 } >hashtable "testhash" set
  56
  57 [ f f ] [
  58     "visual basic" "testhash" get delete-at
  59     "visual basic" "testhash" get at*
  60 ] unit-test
  61
  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
  69
  70 ! Testing the hash element counting
  71
  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
  81
  82 ! Test rehashing
  83
  84 2 <hashtable> "rehash" set
  85
  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
  92
  93 [ 6 ] [ "rehash" get assoc-size ] unit-test
  94
  95 [ 6 ] [ "rehash" get clone assoc-size ] unit-test
  96
  97 "rehash" get clear-assoc
  98
  99 [ 0 ] [ "rehash" get assoc-size ] unit-test
 100
 101 [
 102     3
 103 ] [
 104     2 H{
 105         { 1 2 }
 106         { 2 3 }
 107     } clone at
 108 ] unit-test
 109
 110 ! There was an assoc in place of assoc* somewhere
 111 3 <hashtable> "f-hash-test" set
 112
 113 10 [ f f "f-hash-test" get set-at ] times
 114
 115 [ 1 ] [ "f-hash-test" get assoc-size ] unit-test
 116
 117 ! Resource leak...
 118 H{ } "x" set
 119 100 [ drop "x" get clear-assoc ] each-integer
 120
 121 ! Crash discovered by erg
 122 [ t ] [ 0.75 <hashtable> dup clone = ] unit-test
 123
 124 ! Another crash discovered by erg
 125 [ ] [
 126     H{ } clone
 127     [ 1 swap set-at ] ignore-errors
 128     [ 2 swap set-at ] ignore-errors
 129     [ 3 swap set-at ] ignore-errors
 130     drop
 131 ] unit-test
 132
 133 [ H{ { -1 4 } { -3 16 } { -5 36 } } ] [
 134     H{ { 1 2 } { 3 4 } { 5 6 } }
 135     [ [ neg ] dip sq ] assoc-map
 136 ] unit-test
 137
 138 ! Bug discovered by littledan
 139 [ { 5 5 5 5 } ] [
 140     [
 141         H{
 142             { 1 2 }
 143             { 2 3 }
 144             { 3 4 }
 145             { 4 5 }
 146             { 5 6 }
 147         } clone
 148         dup keys length ,
 149         dup assoc-size ,
 150         dup rehash
 151         dup keys length ,
 152         assoc-size ,
 153     ] { } make
 154 ] unit-test
 155
 156 [ { "one" "two" 3 } ] [
 157     { 1 2 3 } H{ { 1 "one" } { 2 "two" } } substitute
 158 ] unit-test
 159
 160 ! We want this to work
 161 [ ] [ hashtable new "h" set ] unit-test
 162
 163 [ 0 ] [ "h" get assoc-size ] unit-test
 164
 165 [ f f ] [ "goo" "h" get at* ] unit-test
 166
 167 [ ] [ 1 2 "h" get set-at ] unit-test
 168
 169 [ 1 ] [ "h" get assoc-size ] unit-test
 170
 171 [ 1 ] [ 2 "h" get at ] unit-test
 172
 173 ! Random test case
 174 [ "A" ] [ 100 iota [ dup ] H{ } map>assoc 32 over delete-at "A" 32 pick set-at 32 swap at ] unit-test