src/tests.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          memstore-tests.lisp
   6 ;;;; Purpose:       memstore tests file
   7 ;;;; Author:        Kevin M. Rosenberg
   8 ;;;; Date Started:  July 2011
   9 ;;;;
  10 ;;;; This file is Copyright (c) 2011 by Kevin M. Rosenberg
  11 ;;;;
  12 ;;;; *************************************************************************
  13
  14 (in-package #:cl)
  15 (defpackage #:memstore-tests
  16   (:import-from #:rtest #:*compile-tests* #:*expected-failures*)
  17   (:use #:memstore #:cl #:rtest)
  18   (:import-from #:memstore #:ms-store #:ms-restore #:ms-del
  19                 #:ms-serialize #:ms-deserialize
  20                 #:serialize-clstore #:deserialize-clstore
  21                 #:serialize-string #:deserialize-string
  22                 #:+flag-wstring+ #:+flag-clstore+
  23                 #:+flag-zlib+ #:*namespace*
  24                 #:compress #:uncompress)
  25   (:import-from #:memcache #:*memcache* #:*use-pool*
  26                 #:make-memcache-instance))
  27 (in-package #:memstore-tests)
  28
  29 (eval-when (:compile-toplevel :load-toplevel :execute)
  30   (defparameter *test-cnt* 0)
  31   (defvar *test-namespace* "__mctest__:"))
  32
  33 (unless *memcache*
  34   (setq *memcache* (make-memcache-instance :name "Memcache test")))
  35
  36 (rem-all-tests)
  37
  38 (defun run-tests (&key (compiled *compile-tests*))
  39   (let ((*compile-tests* compiled))
  40     (rtest:do-tests)))
  41
  42 (defmacro def-readably-value* (val)
  43   `(progn
  44      (deftest ,(intern (format nil "DS.~D" *test-cnt*) '#:keyword)
  45          (let* ((ser (ms-serialize (quote ,val)))
  46                 (flags (car ser)))
  47            (cond
  48              ((stringp (quote ,val))
  49               (unless (and (zerop (logand flags +flag-wstring+))
  50                            (zerop (logand flags +flag-clstore+)))
  51                 (error "Should be stored as simple string.")))
  52              (t
  53               (unless (and (plusp (logand flags +flag-wstring+))
  54                            (zerop (logand flags +flag-clstore+)))
  55                 (error "Should be stored as wstring."))))
  56            (ms-deserialize ser))
  57        ,val)
  58      (deftest ,(intern (format nil "RS.~D" *test-cnt*) '#:keyword)
  59        (deserialize-clstore (serialize-clstore (quote ,val)))
  60        ,val)
  61      (deftest ,(intern (format nil "SS.~D" *test-cnt*) '#:keyword)
  62        (deserialize-string (serialize-string (quote ,val)))
  63        ,val)
  64      (deftest ,(intern (format nil "MC.~D" *test-cnt*) '#:keyword)
  65          (let ((*namespace* ,*test-namespace*)
  66                (key (format nil "~D" ,*test-cnt*)))
  67            (ms-store key (quote ,val))
  68            (multiple-value-bind (res found) (ms-restore key)
  69              (ms-del key)
  70              (values found (equalp res (quote ,val)))))
  71        t t)
  72      ,(incf *test-cnt*)))
  73
  74 (defmacro def-readably-value (val)
  75   `(progn
  76      (let ((*use-pool* nil))
  77        (def-readably-value* ,val))
  78      (let ((*use-pool* t))
  79        (def-readably-value* ,val))))
  80
  81 (def-readably-value -1)
  82 (def-readably-value 10)
  83 (def-readably-value 1.5)
  84 (def-readably-value #C(1 2))
  85 (def-readably-value "")
  86 (def-readably-value "abc")
  87 (def-readably-value nil)
  88 (def-readably-value t)
  89 (def-readably-value a)
  90 (def-readably-value :a)
  91 (def-readably-value (a b))
  92 (def-readably-value (a . b))
  93 (def-readably-value (:a . "b"))
  94 (def-readably-value #(0 1 2))
  95 (def-readably-value \#k)
  96 (def-readably-value ((:a . 1) (:b . 2)))
  97 (def-readably-value #(((:a . 1) (:b . 2.5))
  98                     ((:c . "a") (:d . a))))
  99
 100 (deftest :ht.1
 101     (let ((h (make-hash-table :test 'equal)))
 102       (setf (gethash "a" h) "A")
 103       (setf (gethash "b" h) "B")
 104       (let ((ds (ms-deserialize (ms-serialize h))))
 105         (list (hash-table-count ds) (gethash "a" ds) (gethash "b" ds))))
 106   (2 "A" "B"))
 107 (deftest :ht.2
 108     (let ((h (make-hash-table :test 'equal)))
 109       (setf (gethash "a" h) "A")
 110       (setf (gethash "b" h) "B")
 111       (let ((ds (deserialize-clstore (serialize-clstore h))))
 112         (list (hash-table-count ds) (gethash "a" ds) (gethash "b" ds))))
 113   (2 "A" "B"))
 114
 115 #-sbcl
 116 (deftest :ht.3
 117     (let ((h (make-hash-table :test 'equal)))
 118       (setf (gethash "a" h) "A")
 119       (setf (gethash "b" h) "B")
 120       (serialize-string h)) ;; should be nil as hash tables can't be print-readably to string
 121   nil)
 122
 123 ;; SBCL can print hash-tables readably
 124 #+sbcl
 125 (deftest :ht.3
 126     (let ((h (make-hash-table :test 'equal)))
 127       (setf (gethash "a" h) "A")
 128       (setf (gethash "b" h) "B")
 129       (let ((ds (deserialize-string (serialize-string h))))
 130         (list (hash-table-count ds) (gethash "a" ds) (gethash "b" ds))))
 131   (2 "A" "B"))
 132
 133
 134 (defvar *long-string* (make-string 10000 :initial-element #\space))
 135 (defvar *long-array* (make-array '(10000) :initial-element 0))
 136 (deftest :l.1
 137     (let* ((ser (ms-serialize *long-string*))
 138            (data (cdr ser))
 139            (flags (car ser)))
 140       (values (< (length data) (length *long-string*))
 141               (eql (logand flags +flag-zlib+) +flag-zlib+)
 142               (zerop (logand flags +flag-wstring+))
 143               (zerop (logand flags +flag-clstore+))
 144               (string-equal *long-string* (ms-deserialize ser))))
 145   t t t t t)
 146
 147 (deftest :l.2
 148     (let* ((ser (ms-serialize *long-array*))
 149            (data (cdr ser))
 150            (flags (car ser)))
 151       (values (< (length data) (length *long-array*))
 152               (eql (logand flags +flag-zlib+) +flag-zlib+)
 153               (eql (logand flags +flag-wstring+) +flag-wstring+)
 154               (zerop (logand flags +flag-clstore+))
 155               (equalp *long-array* (ms-deserialize ser))))
 156   t t t t t)
 157
 158 (deftest :incr.1
 159     (let ((*namespace* *test-namespace*))
 160       (values
 161        (ms-store "i" 0)
 162        (ms-restore "i")
 163        (ms-incr "i")
 164        (ms-incr "i" :delta 5)
 165        (ms-incr "i" :delta 3)
 166        (ms-decr "i" :delta 2)
 167        (ms-decr "i")
 168        (ms-del "i")))
 169   "STORED" 0 1 6 9 7 6 "DELETED")
 170
 171 (deftest :nf.1
 172     (let ((*namespace* *test-namespace*))
 173       (ms-restore "a"))
 174   nil nil)
 175
 176 (defmacro def-compress-test (length id)
 177   (let ((len (gensym "LENGTH-")))
 178     `(deftest ,(intern (format nil "Z.~D" id)
 179                          (find-package '#:keyword))
 180          (block z
 181            (let* ((,len ,length)
 182                   (a (make-array (list ,len) :element-type '(unsigned-byte 8))))
 183              (dotimes (j ,len)
 184                (setf (aref a j) (random 256)))
 185              (let* ((comp (compress a))
 186                     (uncomp (uncompress comp)))
 187                (unless (equalp a uncomp)
 188                  (throw 'z :error)))))
 189          nil)))
 190
 191 (def-compress-test (random 10000) 0)
 192 (def-compress-test (random 10000) 1)
 193 (def-compress-test (random 10000) 2)
 194 (def-compress-test (random 10000) 3)
 195 (def-compress-test (random 10000) 4)
 196 (def-compress-test (random 10000) 5)
 197 (def-compress-test (random 10000) 6)
 198 (def-compress-test (random 10000) 7)
 199 (def-compress-test (random 10000) 8)
 200 (def-compress-test (random 10000) 9)
 201 (def-compress-test (random 10000) 10)
 202
 203