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 #:mem-store #:mem-restore #:mem-del
  19                 #:serialize #:deserialize
  20                 #:serialize-clstore #:deserialize-clstore
  21                 #:serialize-string #:deserialize-string
  22                 #:+flag-wstring+ #:+flag-clstore+
  23                 #:+flag-zlib+ #:*realm*)
  24   (:import-from #:memcache #:*memcache* #:*use-pool*
  25                 #:make-memcache-instance))
  26 (in-package #:memstore-tests)
  27
  28 (eval-when (:compile-toplevel :load-toplevel :execute)
  29   (defparameter *test-cnt* 0)
  30   (defvar *test-realm* "__mctest__:"))
  31
  32 (unless *memcache*
  33   (setq *memcache* (make-memcache-instance :name "Memcache test")))
  34
  35 (rem-all-tests)
  36
  37 (defun run-tests (&key (compiled *compile-tests*))
  38   (let ((*compile-tests* compiled))
  39     (rtest:do-tests)))
  40
  41 (defmacro def-readably-value* (val)
  42   `(progn
  43      (deftest ,(intern (format nil "DS.~D" *test-cnt*) '#:keyword)
  44          (let* ((ser (serialize (quote ,val)))
  45                 (flags (car ser)))
  46            (cond
  47              ((stringp (quote ,val))
  48               (unless (and (zerop (logand flags +flag-wstring+))
  49                            (zerop (logand flags +flag-clstore+)))
  50                 (error "Should be stored as simple string.")))
  51              (t
  52               (unless (and (plusp (logand flags +flag-wstring+))
  53                            (zerop (logand flags +flag-clstore+)))
  54                 (error "Should be stored as wstring."))))
  55            (deserialize ser))
  56        ,val)
  57      (deftest ,(intern (format nil "RS.~D" *test-cnt*) '#:keyword)
  58        (deserialize-clstore (serialize-clstore (quote ,val)))
  59        ,val)
  60      (deftest ,(intern (format nil "SS.~D" *test-cnt*) '#:keyword)
  61        (deserialize-string (serialize-string (quote ,val)))
  62        ,val)
  63      (deftest ,(intern (format nil "MC.~D" *test-cnt*) '#:keyword)
  64          (let ((*realm* ,*test-realm*)
  65                (key (format nil "~D" ,*test-cnt*)))
  66            (mem-store key (quote ,val))
  67            (multiple-value-bind (res found) (mem-restore key)
  68              (mem-del key)
  69              (values found (equalp res (quote ,val)))))
  70        t t)
  71      ,(incf *test-cnt*)))
  72
  73 (defmacro def-readably-value (val)
  74   `(progn
  75      (let ((*use-pool* nil))
  76        (def-readably-value* ,val))
  77      (let ((*use-pool* t))
  78        (def-readably-value* ,val))))
  79
  80 (def-readably-value -1)
  81 (def-readably-value 10)
  82 (def-readably-value 1.5)
  83 (def-readably-value #C(1 2))
  84 (def-readably-value "")
  85 (def-readably-value "abc")
  86 (def-readably-value nil)
  87 (def-readably-value t)
  88 (def-readably-value a)
  89 (def-readably-value :a)
  90 (def-readably-value (a b))
  91 (def-readably-value (a . b))
  92 (def-readably-value (:a . "b"))
  93 (def-readably-value #(0 1 2))
  94 (def-readably-value \#k)
  95 (def-readably-value ((:a . 1) (:b . 2)))
  96 (def-readably-value #(((:a . 1) (:b . 2.5))
  97                     ((:c . "a") (:d . a))))
  98
  99 (deftest :ht.1
 100     (let ((h (make-hash-table :test 'equal)))
 101       (setf (gethash "a" h) "A")
 102       (setf (gethash "b" h) "B")
 103       (let ((ds (deserialize (serialize h))))
 104         (list (hash-table-count ds) (gethash "a" ds) (gethash "b" ds))))
 105   (2 "A" "B"))
 106 (deftest :ht.2
 107     (let ((h (make-hash-table :test 'equal)))
 108       (setf (gethash "a" h) "A")
 109       (setf (gethash "b" h) "B")
 110       (let ((ds (deserialize-clstore (serialize-clstore h))))
 111         (list (hash-table-count ds) (gethash "a" ds) (gethash "b" ds))))
 112   (2 "A" "B"))
 113
 114 #-sbcl
 115 (deftest :ht.3
 116     (let ((h (make-hash-table :test 'equal)))
 117       (setf (gethash "a" h) "A")
 118       (setf (gethash "b" h) "B")
 119       (serialize-string h)) ;; should be nil as hash tables can't be print-readably to string
 120   nil)
 121
 122 ;; SBCL can print hash-tables readably
 123 #+sbcl
 124 (deftest :ht.3
 125     (let ((h (make-hash-table :test 'equal)))
 126       (setf (gethash "a" h) "A")
 127       (setf (gethash "b" h) "B")
 128       (let ((ds (deserialize-string (serialize-string h))))
 129         (list (hash-table-count ds) (gethash "a" ds) (gethash "b" ds))))
 130   (2 "A" "B"))
 131
 132
 133 (defvar *long-string* (make-string 10000 :initial-element #\space))
 134 (defvar *long-array* (make-array '(10000) :initial-element 0))
 135 (deftest :l.1
 136     (let* ((ser (serialize *long-string*))
 137            (data (cdr ser))
 138            (flags (car ser)))
 139       (values (< (length data) (length *long-string*))
 140               (eql (logand flags +flag-zlib+) +flag-zlib+)
 141               (zerop (logand flags +flag-wstring+))
 142               (zerop (logand flags +flag-clstore+))
 143               (string-equal *long-string* (deserialize ser))))
 144   t t t t t)
 145
 146 (deftest :l.2
 147     (let* ((ser (serialize *long-array*))
 148            (data (cdr ser))
 149            (flags (car ser)))
 150       (values (< (length data) (length *long-array*))
 151               (eql (logand flags +flag-zlib+) +flag-zlib+)
 152               (eql (logand flags +flag-wstring+) +flag-wstring+)
 153               (zerop (logand flags +flag-clstore+))
 154               (equalp *long-array* (deserialize ser))))
 155   t t t t t)
 156
 157 (deftest :incr.1
 158     (let ((*realm* *test-realm*))
 159       (values
 160        (mem-store "i" 0)
 161        (mem-restore "i")
 162        (mem-incr "i")
 163        (mem-incr "i" :delta 5)
 164        (mem-incr "i" :delta 3)
 165        (mem-decr "i" :delta 2)
 166        (mem-decr "i")
 167        (mem-del "i")))
 168   "STORED" 0 1 6 9 7 6 "DELETED")
 169
 170 (deftest :nf.1
 171     (let ((*realm* *test-realm*))
 172       (mem-restore "a"))
 173   nil nil)