basis/persistent/hashtables/hashtables-tests.factor

   1 IN: persistent.hashtables.tests
   2 USING: persistent.hashtables persistent.assocs hashtables assocs
   3 tools.test kernel locals namespaces random ranges sequences fry ;
   4
   5 { t } [ PH{ } assoc-empty? ] unit-test
   6
   7 { PH{ { "A" "B" } } } [ PH{ } "B" "A" rot new-at ] unit-test
   8
   9 { "B" } [ "A" PH{ { "A" "B" } } at ] unit-test
  10
  11 { f } [ "X" PH{ { "A" "B" } } at ] unit-test
  12
  13 ! We have to define these first so that they're compiled before
  14 ! the below hashtables are parsed...
  15 <<
  16
  17 TUPLE: hash-0-a ;
  18
  19 M: hash-0-a hashcode* 2drop 0 ;
  20
  21 TUPLE: hash-0-b ;
  22
  23 M: hash-0-b hashcode* 2drop 0 ;
  24
  25 >>
  26
  27 { } [
  28     PH{ }
  29     "a" T{ hash-0-a } rot new-at
  30     "b" T{ hash-0-b } rot new-at
  31     "ph" set
  32 ] unit-test
  33
  34 {
  35     H{
  36         { T{ hash-0-a } "a" }
  37         { T{ hash-0-b } "b" }
  38     }
  39 } [ "ph" get >hashtable ] unit-test
  40
  41 {
  42     H{
  43         { T{ hash-0-b } "b" }
  44     }
  45 } [ "ph" get T{ hash-0-a } swap pluck-at >hashtable ] unit-test
  46
  47 {
  48     H{
  49         { T{ hash-0-a } "a" }
  50     }
  51 } [ "ph" get T{ hash-0-b } swap pluck-at >hashtable ] unit-test
  52
  53 {
  54     H{
  55         { T{ hash-0-a } "a" }
  56         { T{ hash-0-b } "b" }
  57     }
  58 } [ "ph" get "X" swap pluck-at >hashtable ] unit-test
  59
  60 { } [
  61     PH{ }
  62     "B" "A" rot new-at
  63     "D" "C" rot new-at
  64     "ph" set
  65 ] unit-test
  66
  67 { H{ { "A" "B" } { "C" "D" } } } [
  68     "ph" get >hashtable
  69 ] unit-test
  70
  71 { H{ { "C" "D" } } } [
  72     "ph" get "A" swap pluck-at >hashtable
  73 ] unit-test
  74
  75 { H{ { "A" "B" } { "C" "D" } { "E" "F" } } } [
  76     "ph" get "F" "E" rot new-at >hashtable
  77 ] unit-test
  78
  79 { H{ { "C" "D" } { "E" "F" } } } [
  80     "ph" get "F" "E" rot new-at "A" swap pluck-at >hashtable
  81 ] unit-test
  82
  83 : random-string ( -- str )
  84     1000000 random ;
  85     ! [ CHAR: a CHAR: z [a..b] random ] "" replicate-as ;
  86
  87 : random-assocs ( n -- hash phash )
  88     [ random-string ] replicate
  89     [ H{ } clone [ '[ swap _ set-at ] each-index ] keep ]
  90     [ PH{ } clone swap [| ph elt i | i elt ph new-at ] each-index ]
  91     bi ;
  92
  93 : ok? ( assoc1 assoc2 -- ? )
  94     [ assoc= ] [ [ assoc-size ] same? ] 2bi and ;
  95
  96 : test-persistent-hashtables-1 ( n -- ? )
  97     random-assocs ok? ;
  98
  99 { t } [ 10 test-persistent-hashtables-1 ] unit-test
 100 { t } [ 20 test-persistent-hashtables-1 ] unit-test
 101 { t } [ 30 test-persistent-hashtables-1 ] unit-test
 102 { t } [ 50 test-persistent-hashtables-1 ] unit-test
 103 { t } [ 100 test-persistent-hashtables-1 ] unit-test
 104 { t } [ 500 test-persistent-hashtables-1 ] unit-test
 105 { t } [ 1000 test-persistent-hashtables-1 ] unit-test
 106 { t } [ 5000 test-persistent-hashtables-1 ] unit-test
 107 { t } [ 10000 test-persistent-hashtables-1 ] unit-test
 108 { t } [ 50000 test-persistent-hashtables-1 ] unit-test
 109
 110 : test-persistent-hashtables-2 ( n -- ? )
 111     random-assocs
 112     dup keys [
 113         [ nip over delete-at ] [ swap pluck-at nip ] 3bi
 114         2dup ok?
 115     ] all? 2nip ;
 116
 117 { t } [ 6000 test-persistent-hashtables-2 ] unit-test