basis/persistent/hashtables/hashtables-tests.factor

   1 IN: persistent.hashtables.tests
   2 USING: persistent.hashtables persistent.assocs hashtables assocs
   3 tools.test kernel namespaces random math.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 ; ! [ CHAR: a CHAR: z [a,b] random ] "" replicate-as ;
  85
  86 : random-assocs ( -- hash phash )
  87     [ random-string ] replicate
  88     [ H{ } clone [ '[ swap _ set-at ] each-index ] keep ]
  89     [ PH{ } clone swap [ spin new-at ] each-index ]
  90     bi ;
  91
  92 : ok? ( assoc1 assoc2 -- ? )
  93     [ assoc= ] [ [ assoc-size ] bi@ = ] 2bi and ;
  94
  95 : test-persistent-hashtables-1 ( n -- )
  96     random-assocs ok? ;
  97
  98 [ t ] [ 10 test-persistent-hashtables-1 ] unit-test
  99 [ t ] [ 20 test-persistent-hashtables-1 ] unit-test
 100 [ t ] [ 30 test-persistent-hashtables-1 ] unit-test
 101 [ t ] [ 50 test-persistent-hashtables-1 ] unit-test
 102 [ t ] [ 100 test-persistent-hashtables-1 ] unit-test
 103 [ t ] [ 500 test-persistent-hashtables-1 ] unit-test
 104 [ t ] [ 1000 test-persistent-hashtables-1 ] unit-test
 105 [ t ] [ 5000 test-persistent-hashtables-1 ] unit-test
 106 [ t ] [ 10000 test-persistent-hashtables-1 ] unit-test
 107 [ t ] [ 50000 test-persistent-hashtables-1 ] unit-test
 108
 109 : test-persistent-hashtables-2 ( n -- )
 110     random-assocs
 111     dup keys [
 112         [ nip over delete-at ] [ swap pluck-at nip ] 3bi
 113         2dup ok?
 114     ] all? 2nip ;
 115
 116 [ t ] [ 6000 test-persistent-hashtables-2 ] unit-test