;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:          memstore-tests.lisp
;;;; Purpose:       memstore tests file
;;;; Author:        Kevin M. Rosenberg
;;;; Date Started:  July 2011
;;;;
;;;; This file is Copyright (c) 2011 by Kevin M. Rosenberg
;;;;
;;;; *************************************************************************

(in-package #:cl)
(defpackage #:memstore-tests
  (:import-from #:rtest #:*compile-tests* #:*expected-failures*)
  (:use #:memstore #:cl #:rtest)
  (:import-from #:memstore #:ms-store #:ms-restore #:ms-del
                #:ms-serialize #:ms-deserialize
                #:serialize-clstore #:deserialize-clstore
                #:serialize-string #:deserialize-string
                #:+flag-wstring+ #:+flag-clstore+
                #:+flag-zlib+ #:*namespace*
                #:compress #:uncompress)
  (:import-from #:memcache #:*memcache* #:*use-pool*
                #:make-memcache-instance))
(in-package #:memstore-tests)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter *test-cnt* 0)
  (defvar *test-namespace* "__mctest__:"))

(unless *memcache*
  (setq *memcache* (make-memcache-instance :name "Memcache test")))

(rem-all-tests)

(defun run-tests (&key (compiled *compile-tests*))
  (let ((*compile-tests* compiled))
    (rtest:do-tests)))

(defmacro def-readably-value* (val)
  `(progn
     (deftest ,(intern (format nil "DS.~D" *test-cnt*) '#:keyword)
         (let* ((ser (ms-serialize (quote ,val)))
                (flags (car ser)))
           (cond
             ((stringp (quote ,val))
              (unless (and (zerop (logand flags +flag-wstring+))
                           (zerop (logand flags +flag-clstore+)))
                (error "Should be stored as simple string.")))
             (t
              (unless (and (plusp (logand flags +flag-wstring+))
                           (zerop (logand flags +flag-clstore+)))
                (error "Should be stored as wstring."))))
           (ms-deserialize ser))
       ,val)
     (deftest ,(intern (format nil "RS.~D" *test-cnt*) '#:keyword)
       (deserialize-clstore (serialize-clstore (quote ,val)))
       ,val)
     (deftest ,(intern (format nil "SS.~D" *test-cnt*) '#:keyword)
       (deserialize-string (serialize-string (quote ,val)))
       ,val)
     (deftest ,(intern (format nil "MC.~D" *test-cnt*) '#:keyword)
         (let ((*namespace* ,*test-namespace*)
               (key (format nil "~D" ,*test-cnt*)))
           (ms-store key (quote ,val))
           (multiple-value-bind (res found) (ms-restore key)
             (ms-del key)
             (values found (equalp res (quote ,val)))))
       t t)
     ,(incf *test-cnt*)))

(defmacro def-readably-value (val)
  `(progn
     (let ((*use-pool* nil))
       (def-readably-value* ,val))
     (let ((*use-pool* t))
       (def-readably-value* ,val))))

(def-readably-value -1)
(def-readably-value 10)
(def-readably-value 1.5)
(def-readably-value #C(1 2))
(def-readably-value "")
(def-readably-value "abc")
(def-readably-value nil)
(def-readably-value t)
(def-readably-value a)
(def-readably-value :a)
(def-readably-value (a b))
(def-readably-value (a . b))
(def-readably-value (:a . "b"))
(def-readably-value #(0 1 2))
(def-readably-value \#k)
(def-readably-value ((:a . 1) (:b . 2)))
(def-readably-value #(((:a . 1) (:b . 2.5))
                    ((:c . "a") (:d . a))))

(deftest :ht.1
    (let ((h (make-hash-table :test 'equal)))
      (setf (gethash "a" h) "A")
      (setf (gethash "b" h) "B")
      (let ((ds (ms-deserialize (ms-serialize h))))
        (list (hash-table-count ds) (gethash "a" ds) (gethash "b" ds))))
  (2 "A" "B"))
(deftest :ht.2
    (let ((h (make-hash-table :test 'equal)))
      (setf (gethash "a" h) "A")
      (setf (gethash "b" h) "B")
      (let ((ds (deserialize-clstore (serialize-clstore h))))
        (list (hash-table-count ds) (gethash "a" ds) (gethash "b" ds))))
  (2 "A" "B"))

#-sbcl
(deftest :ht.3
    (let ((h (make-hash-table :test 'equal)))
      (setf (gethash "a" h) "A")
      (setf (gethash "b" h) "B")
      (serialize-string h)) ;; should be nil as hash tables can't be print-readably to string
  nil)

;; SBCL can print hash-tables readably
#+sbcl
(deftest :ht.3
    (let ((h (make-hash-table :test 'equal)))
      (setf (gethash "a" h) "A")
      (setf (gethash "b" h) "B")
      (let ((ds (deserialize-string (serialize-string h))))
        (list (hash-table-count ds) (gethash "a" ds) (gethash "b" ds))))
  (2 "A" "B"))


(defvar *long-string* (make-string 10000 :initial-element #\space))
(defvar *long-array* (make-array '(10000) :initial-element 0))
(deftest :l.1
    (let* ((ser (ms-serialize *long-string*))
           (data (cdr ser))
           (flags (car ser)))
      (values (< (length data) (length *long-string*))
              (eql (logand flags +flag-zlib+) +flag-zlib+)
              (zerop (logand flags +flag-wstring+))
              (zerop (logand flags +flag-clstore+))
              (string-equal *long-string* (ms-deserialize ser))))
  t t t t t)

(deftest :l.2
    (let* ((ser (ms-serialize *long-array*))
           (data (cdr ser))
           (flags (car ser)))
      (values (< (length data) (length *long-array*))
              (eql (logand flags +flag-zlib+) +flag-zlib+)
              (eql (logand flags +flag-wstring+) +flag-wstring+)
              (zerop (logand flags +flag-clstore+))
              (equalp *long-array* (ms-deserialize ser))))
  t t t t t)

(deftest :incr.1
    (let ((*namespace* *test-namespace*))
      (values
       (ms-store "i" 0)
       (ms-restore "i")
       (ms-incr "i")
       (ms-incr "i" :delta 5)
       (ms-incr "i" :delta 3)
       (ms-decr "i" :delta 2)
       (ms-decr "i")
       (ms-del "i")))
  "STORED" 0 1 6 9 7 6 "DELETED")

(deftest :nf.1
    (let ((*namespace* *test-namespace*))
      (ms-restore "a"))
  nil nil)

(defmacro def-compress-test (length id)
  (let ((len (gensym "LENGTH-")))
    `(deftest ,(intern (format nil "Z.~D" id)
                         (find-package '#:keyword))
         (block z
           (let* ((,len ,length)
                  (a (make-array (list ,len) :element-type '(unsigned-byte 8))))
             (dotimes (j ,len)
               (setf (aref a j) (random 256)))
             (let* ((comp (compress a))
                    (uncomp (uncompress comp)))
               (unless (equalp a uncomp)
                 (throw 'z :error)))))
         nil)))

(def-compress-test (random 10000) 0)
(def-compress-test (random 10000) 1)
(def-compress-test (random 10000) 2)
(def-compress-test (random 10000) 3)
(def-compress-test (random 10000) 4)
(def-compress-test (random 10000) 5)
(def-compress-test (random 10000) 6)
(def-compress-test (random 10000) 7)
(def-compress-test (random 10000) 8)
(def-compress-test (random 10000) 9)
(def-compress-test (random 10000) 10)