core/hashtables/hashtables-tests.factor

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