;;;; -*- 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 #:mem-store #:mem-restore #:mem-del
                #:serialize #:deserialize
                #:serialize-clstore #:deserialize-clstore
                #:serialize-string #:deserialize-string
                #:+flag-wstring+ #:+flag-clstore+
                #:+flag-zlib+ #:*realm*)
  (: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-realm* "__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 (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."))))
           (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 ((*realm* ,*test-realm*)
               (key (format nil "~D" ,*test-cnt*)))
           (mem-store key (quote ,val))
           (multiple-value-bind (res found) (mem-restore key)
             (mem-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 (deserialize (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 (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* (deserialize ser))))
  t t t t t)

(deftest :l.2
    (let* ((ser (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* (deserialize ser))))
  t t t t t)

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

(deftest :nf.1
    (let ((*realm* *test-realm*))
      (mem-restore "a"))
  nil nil)