extra/memcached/memcached-tests.factor

   1 ! Copyright (C) 2010 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: arrays assocs calendar io io.encodings.binary io.sockets
   5 io.timeouts kernel math math.functions memcached
   6 memcached.private namespaces present sequences sorting system
   7 threads tools.test ;
   8
   9 QUALIFIED: memcached
  10
  11 IN: memcached.tests
  12
  13 ! Use a version of with-memcached that sets a timeout
  14 : with-memcached ( quot -- )
  15     [ 5 seconds input-stream get set-timeout ] prepose
  16     memcached:with-memcached ; inline
  17
  18 <PRIVATE
  19
  20 : not-found? ( quot -- )
  21     [ key-not-found? ] must-fail-with ;
  22
  23 : x ( -- str ) cpu present "-x" append ;
  24 : y ( -- str ) cpu present "-y" append ;
  25 : z ( -- str ) cpu present "-z" append ;
  26
  27 PRIVATE>
  28
  29 ! test version
  30 [ t ] [ [ m/version ] with-memcached length 0 > ] unit-test
  31
  32 ! test simple set get
  33 [ m/flush ] with-memcached
  34 [ "valuex" x m/set ] with-memcached
  35 [ "valuex" ] [ [ x m/get ] with-memcached ] unit-test
  36
  37 ! test flush
  38 [ m/flush ] with-memcached
  39 [ "valuex" x m/set "valuey" y m/set ] with-memcached
  40 [ "valuex" ] [ [ x m/get ] with-memcached ] unit-test
  41 [ "valuey" ] [ [ y m/get ] with-memcached ] unit-test
  42 [ m/flush ] with-memcached
  43 [ [ x m/get ] with-memcached ] not-found?
  44 [ [ y m/get ] with-memcached ] not-found?
  45
  46 ! test noop
  47 [ m/noop ] with-memcached
  48
  49 ! test delete
  50 [ m/flush ] with-memcached
  51 [ "valuex" x m/set ] with-memcached
  52 [ "valuex" ] [ [ x m/get ] with-memcached ] unit-test
  53 [ x m/delete ] with-memcached
  54 [ [ x m/get ] with-memcached ] not-found?
  55
  56 ! test replace
  57 [ m/flush ] with-memcached
  58 [ [ x m/get ] with-memcached ] not-found?
  59 [ [ "ex" x m/replace ] with-memcached ] not-found?
  60 [ "ex" x m/add ] with-memcached
  61 [ "ex" ] [ [ x m/get ] with-memcached ] unit-test
  62 [ "ex2" x m/replace ] with-memcached
  63 [ "ex2" ] [ [ x m/get ] with-memcached ] unit-test
  64
  65 ! test incr
  66 [ m/flush ] with-memcached
  67 [ 0 ] [ [ x m/incr ] with-memcached ] unit-test
  68 [ 1 ] [ [ x m/incr ] with-memcached ] unit-test
  69 [ 212 ] [ [ 211 x m/incr-val ] with-memcached ] unit-test
  70 [ 8589934804 ] [ [ 2 33 ^ x m/incr-val ] with-memcached ] unit-test
  71
  72 ! test decr
  73 [ m/flush ] with-memcached
  74 [ "5" x m/set ] with-memcached
  75 [ 4 ] [ [ x m/decr ] with-memcached ] unit-test
  76 [ 0 ] [ [ 211 x m/decr-val ] with-memcached ] unit-test
  77
  78 ! test timebombed flush
  79 [ m/flush ] with-memcached
  80 [ [ x m/get ] with-memcached ] not-found?
  81 [ "valuex" x m/set ] with-memcached
  82 [ "valuex" ] [ [ x m/get ] with-memcached ] unit-test
  83 [ 2 m/flush-later ] with-memcached
  84 [ "valuex" ] [ [ x m/get ] with-memcached ] unit-test
  85 3 seconds sleep
  86 [ [ x m/get ] with-memcached ] not-found?
  87
  88 ! test append
  89 [ m/flush ] with-memcached
  90 [ "some" x m/set ] with-memcached
  91 [ "thing" x m/append ] with-memcached
  92 [ "something" ] [ [ x m/get ] with-memcached ] unit-test
  93
  94 ! test prepend
  95 [ m/flush ] with-memcached
  96 [ "some" x m/set ] with-memcached
  97 [ "thing" x m/prepend ] with-memcached
  98 [ "thingsome" ] [ [ x m/get ] with-memcached ] unit-test
  99
 100 ! test multi-get
 101 [ m/flush ] with-memcached
 102 [ H{ } ] [ [ x y z 3array m/getseq ] with-memcached ] unit-test
 103 [ "5" x m/set ] with-memcached
 104 [ "valuex" y m/set ] with-memcached
 105 [ { "5" "valuex" } ] [
 106     [ x y z 3array m/getseq values natural-sort ] with-memcached
 107 ] unit-test
 108
 109
 110
 111