1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: memstore-tests.lisp
6 ;;;; Purpose: memstore tests file
7 ;;;; Author: Kevin M. Rosenberg
8 ;;;; Date Started: July 2011
10 ;;;; This file is Copyright (c) 2011 by Kevin M. Rosenberg
12 ;;;; *************************************************************************
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)
29 (eval-when (:compile-toplevel :load-toplevel :execute)
30 (defparameter *test-cnt* 0)
31 (defvar *test-namespace* "__mctest__:"))
34 (setq *memcache* (make-memcache-instance :name "Memcache test")))
38 (defun run-tests (&key (compiled *compile-tests*))
39 (let ((*compile-tests* compiled))
42 (defmacro def-readably-value* (val)
44 (deftest ,(intern (format nil "DS.~D" *test-cnt*) '#:keyword)
45 (let* ((ser (ms-serialize (quote ,val)))
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.")))
53 (unless (and (plusp (logand flags +flag-wstring+))
54 (zerop (logand flags +flag-clstore+)))
55 (error "Should be stored as wstring."))))
58 (deftest ,(intern (format nil "RS.~D" *test-cnt*) '#:keyword)
59 (deserialize-clstore (serialize-clstore (quote ,val)))
61 (deftest ,(intern (format nil "SS.~D" *test-cnt*) '#:keyword)
62 (deserialize-string (serialize-string (quote ,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)
70 (values found (equalp res (quote ,val)))))
74 (defmacro def-readably-value (val)
76 (let ((*use-pool* nil))
77 (def-readably-value* ,val))
79 (def-readably-value* ,val))))
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))))
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))))
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))))
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
123 ;; SBCL can print hash-tables readably
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))))
134 (defvar *long-string* (make-string 10000 :initial-element #\space))
135 (defvar *long-array* (make-array '(10000) :initial-element 0))
137 (let* ((ser (ms-serialize *long-string*))
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))))
148 (let* ((ser (ms-serialize *long-array*))
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))))
159 (let ((*namespace* *test-namespace*))
164 (ms-incr "i" :delta 5)
165 (ms-incr "i" :delta 3)
166 (ms-decr "i" :delta 2)
169 "STORED" 0 1 6 9 7 6 "DELETED")
172 (let ((*namespace* *test-namespace*))
176 (defmacro def-compress-test (length id)
177 (let ((len (gensym "LENGTH-")))
178 `(deftest ,(intern (format nil "Z.~D" id)
179 (find-package '#:keyword))
181 (let* ((,len ,length)
182 (a (make-array (list ,len) :element-type '(unsigned-byte 8))))
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)))))
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)