Anonymous avatar Anonymous committed 86e6141

Imported Plato Wu's patch to convert the tests to 5am.

Comments (0)

Files changed (8)

src/master-slave.lisp

                                   (return)
                                 (execute prevalence-system transaction)))))))
 
+(defun stop-slave-server (server)
+  ;; Plato Wu,2009/02/26: stop-server need be exported in s-sysdeps.
+  (s-sysdeps::stop-server (caar server))
+  )
+
 ;;;; eof
    #:drop-index-on
    #:find-object-with-slot
 
+   ;; Plato Wu,2009/02/28: Add for testing system.
+   #:close-open-streams
+   #:next-id
+
    #:start-master-client
    #:stop-master-client
    #:start-slave-server

test/cl-prevalence-test.asd

+(in-package :asdf)
+
+(defsystem :cl-prevalence-test
+    :name "CL-PREVALENCE-TEST"
+    :author "Sven Van Caekenberghe <svc@mac.com>;Plato Wu <wangyi000@yeah.net>"
+    :version "2"
+    :maintainer "Plato Wu <wangyi000@yeah.net>"
+    :licence "Lesser Lisp General Public License"
+    :description "Common Lisp Prevalence Test Package"
+    :long-description "5am test suite for cl-prevalence"
+    :components 
+    ((:file "package")
+     (:file "test-prevalence")
+     (:file "test-managed-prevalence")
+     (:file "test-master-slave")
+;     (:file "test-serialization")
+     )
+    :depends-on (:cl-prevalence :fiveam))

test/package.lisp

+(defpackage :cl-prevalence-test
+  (:use :cl :cl-prevalence :5am :s-serialization))

test/test-managed-prevalence.lisp

 ;;;; You are granted the rights to distribute and use this software
 ;;;; as governed by the terms of the Lisp Lesser General Public License
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+(in-package :cl-prevalence-test)
 
-(in-package :cl-prevalence)
+(def-suite test-managed-prevalence)
+
+(in-suite test-managed-prevalence)
 
 (defparameter *test-system-directory* (pathname "/tmp/test-managed-prevalence-system/"))
 
 (defvar *test-system* nil)
 
-;; Create a new prevalence system for testing purposes
-
-(let ((directory *test-system-directory*))
-  ;; Throw away any xml files that we find: we want to start from scratch
-  (when (probe-file directory)
-    (dolist (pathname (directory (merge-pathnames "*.xml" directory)))
-      (delete-file pathname)))
-  (setf *test-system* (make-prevalence-system directory)))
+(test test-managed-prevalence-start
+ "Create a new prevalence system for testing purposes"
+ (let ((directory *test-system-directory*))
+   ;; Throw away any xml files that we find: we want to start from scratch
+   (when (probe-file directory)
+     (dolist (pathname (directory (merge-pathnames "*.xml" directory)))
+       (delete-file pathname)))
+   (setf *test-system* (make-prevalence-system directory))
+   (is-true *test-system*)
+   (index-on *test-system* 'managed-person '(firstname lastname) 'equal)))
 
 ;; A Test CLOS class
 
-(defclass person (object-with-id)
+(defclass managed-person (object-with-id)
   ((firstname :initarg :firstname :initform "" :accessor get-firstname)
    (lastname  :initarg :lastname  :initform "" :accessor get-lastname)))
 
-(defmethod (setf get-firstname) (value (person person))
+(defmethod (setf get-firstname) (value (managed-person managed-person))
   (execute-transaction 
-   (tx-change-object-slots *test-system* 'person (get-id person) (list (list 'firstname value)))))
+   (tx-change-object-slots *test-system* 'managed-person (get-id managed-person) (list (list 'firstname value)))))
 
-(defmethod (setf get-lastname) (value (person person))
+(defmethod (setf get-lastname) (value (managed-person managed-person))
   (execute-transaction 
-   (tx-change-object-slots *test-system* 'person (get-id person) (list (list 'lastname value)))))
-
-(index-on *test-system* 'person '(firstname lastname) 'equal)
+   (tx-change-object-slots *test-system* 'managed-person (get-id managed-person) (list (list 'lastname value)))))
 
 ;; convenience function
 
 
 ;; Some basic functions to construct transactions from
 
-(defun make-person (&rest slots)
+(defun make-managed-person (&rest slots)
   (let ((slots-and-values (pairify slots)))
     (execute-transaction 
-     (tx-create-object *test-system* 'person slots-and-values))))
+     (tx-create-object *test-system* 'managed-person slots-and-values))))
 
-(defun find-person (slot value)
-  (find-object-with-slot *test-system* 'person slot value))
+(defun find-managed-person (slot value)
+  (find-object-with-slot *test-system* 'managed-person slot value))
 
-(defun delete-person (person)
+(defun delete-managed-person (managed-person)
   (execute-transaction 
-   (tx-delete-object *test-system* 'person (get-id person))))
+   (tx-delete-object *test-system* 'managed-person (get-id managed-person))))
 
-;; Create a new id counter
+(test test-create-counter
+  "Create a new id counter"
+  (execute-transaction (tx-create-id-counter *test-system*))
+  (is (zerop (get-root-object *test-system* :id-counter))))
+    
 
-(execute-transaction (tx-create-id-counter *test-system*))
-
-(assert (zerop (get-root-object *test-system* :id-counter)))
-
-;; A place to store our test person's id outside of the system
+;; A place to store our test managed-person's id outside of the system
 
 (defvar *jlp*)
 
-;; Create a new test person
+(test test-create-managed-person
+  "Create a new test managed-person"
+  (let ((managed-person (make-managed-person 'firstname "Jean-Luc" 'lastname "Picard")))
+    (is (eq (class-of managed-person) (find-class 'managed-person)))
+    (is (equal (get-firstname managed-person) "Jean-Luc"))
+    (is (equal (get-lastname managed-person) "Picard"))
+    (is (equal (get-lastname (find-managed-person 'firstname "Jean-Luc")) "Picard"))
+    (setf (get-firstname (find-managed-person 'lastname "Picard")) "J-Lu")
+    (is (equal (get-lastname (find-managed-person 'firstname "J-Lu")) "Picard"))
+    (setf (get-firstname (find-managed-person 'firstname "J-Lu")) "Jean-Luc")
+    (is (equal (get-firstname (find-managed-person 'lastname "Picard")) "Jean-Luc"))
+    (is (eq NIL (find-managed-person 'firstname "J-Lu")))
+    (setf *jlp* (get-id managed-person))))
 
-(let ((person (make-person 'firstname "Jean-Luc" 'lastname "Picard")))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Jean-Luc"))
-  (assert (equal (get-lastname person) "Picard"))
-  (assert (equal (get-lastname (find-person 'firstname "Jean-Luc")) "Picard"))
-  (setf (get-firstname (find-person 'lastname "Picard")) "J-Lu")
-  (assert (equal (get-lastname (find-person 'firstname "J-Lu")) "Picard"))
-  (setf (get-firstname (find-person 'firstname "J-Lu")) "Jean-Luc")
-  (assert (equal (get-firstname (find-person 'lastname "Picard")) "Jean-Luc"))
-  (assert (eq NIL (find-person 'firstname "J-Lu")))
-  (setf *jlp* (get-id person)))
+(test test-get-managed-person
+  (let ((managed-person (find-object-with-id *test-system* 'managed-person *jlp*)))
+    (is (eq (class-of managed-person) (find-class 'managed-person)))
+    (is (equal (get-firstname managed-person) "Jean-Luc"))
+    (is (equal (get-lastname managed-person) "Picard"))
+    (is (equal (get-lastname (find-managed-person 'firstname "Jean-Luc")) "Picard"))
+    (setf (get-firstname (find-managed-person 'lastname "Picard")) "J-Lu")
+    (is (equal (get-lastname (find-managed-person 'firstname "J-Lu")) "Picard"))
+    (setf (get-firstname (find-managed-person 'firstname "J-Lu")) "Jean-Luc")
+    (is (equal (get-firstname (find-managed-person 'lastname "Picard")) "Jean-Luc"))
+    (is (eq NIL (find-managed-person 'firstname "J-Lu")))))
 
-(let ((person (find-object-with-id *test-system* 'person *jlp*)))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Jean-Luc"))
-  (assert (equal (get-lastname person) "Picard"))
-  (assert (equal (get-lastname (find-person 'firstname "Jean-Luc")) "Picard"))
-  (setf (get-firstname (find-person 'lastname "Picard")) "J-Lu")
-  (assert (equal (get-lastname (find-person 'firstname "J-Lu")) "Picard"))
-  (setf (get-firstname (find-person 'firstname "J-Lu")) "Jean-Luc")
-  (assert (equal (get-firstname (find-person 'lastname "Picard")) "Jean-Luc"))
-  (assert (eq NIL (find-person 'firstname "J-Lu"))))
+(test test-find-managed-person-restart
+  "Throw away the previous prevalence instance and start over,
+  counting on a restore operation using the transaction log"
+  (close-open-streams *test-system*)
+  (setf *test-system* (make-prevalence-system *test-system-directory*))
+  (let ((managed-person (find-object-with-id *test-system* 'managed-person *jlp*)))
+    (is (eq (class-of managed-person) (find-class 'managed-person)))
+    (is (equal (get-firstname managed-person) "Jean-Luc"))
+    (is (equal (get-lastname managed-person) "Picard"))
+    (is (equal (get-lastname (find-managed-person 'firstname "Jean-Luc")) "Picard"))
+    (setf (get-firstname (find-managed-person 'lastname "Picard")) "J-Lu")
+    (is (equal (get-lastname (find-managed-person 'firstname "J-Lu")) "Picard"))
+    (setf (get-firstname (find-managed-person 'firstname "J-Lu")) "Jean-Luc")
+    (is (equal (get-firstname (find-managed-person 'lastname "Picard")) "Jean-Luc"))
+    (is (eq NIL (find-managed-person 'firstname "J-Lu")))))
 
-;; Throw away the previous prevalence instance and start over,
-;; counting on a restore operation using the transaction log
+(test test-find-managed-person-snapshot
+  "Create a snapshot of our test system"
+  (snapshot *test-system*)
+  (let ((managed-person (find-object-with-id *test-system* 'managed-person *jlp*)))
+    (is (eq (class-of managed-person) (find-class 'managed-person)))
+    (is (equal (get-firstname managed-person) "Jean-Luc"))
+    (is (equal (get-lastname managed-person) "Picard"))
+    (is (equal (get-lastname (find-managed-person 'firstname "Jean-Luc")) "Picard"))
+    (setf (get-firstname (find-managed-person 'lastname "Picard")) "J-Lu")
+    (is (equal (get-lastname (find-managed-person 'firstname "J-Lu")) "Picard"))
+    (setf (get-firstname (find-managed-person 'firstname "J-Lu")) "Jean-Luc")
+    (is (equal (get-firstname (find-managed-person 'lastname "Picard")) "Jean-Luc"))
+    (is (eq NIL (find-managed-person 'firstname "J-Lu")))))
 
-(close-open-streams *test-system*)
-(setf *test-system* (make-prevalence-system *test-system-directory*))
-
-(let ((person (find-object-with-id *test-system* 'person *jlp*)))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Jean-Luc"))
-  (assert (equal (get-lastname person) "Picard"))
-  (assert (equal (get-lastname (find-person 'firstname "Jean-Luc")) "Picard"))
-  (setf (get-firstname (find-person 'lastname "Picard")) "J-Lu")
-  (assert (equal (get-lastname (find-person 'firstname "J-Lu")) "Picard"))
-  (setf (get-firstname (find-person 'firstname "J-Lu")) "Jean-Luc")
-  (assert (equal (get-firstname (find-person 'lastname "Picard")) "Jean-Luc"))
-  (assert (eq NIL (find-person 'firstname "J-Lu"))))
-
-;; Create a snapshot of our test system
-
-(snapshot *test-system*)
-
-(let ((person (find-object-with-id *test-system* 'person *jlp*)))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Jean-Luc"))
-  (assert (equal (get-lastname person) "Picard"))
-  (assert (equal (get-lastname (find-person 'firstname "Jean-Luc")) "Picard"))
-  (setf (get-firstname (find-person 'lastname "Picard")) "J-Lu")
-  (assert (equal (get-lastname (find-person 'firstname "J-Lu")) "Picard"))
-  (setf (get-firstname (find-person 'firstname "J-Lu")) "Jean-Luc")
-  (assert (equal (get-firstname (find-person 'lastname "Picard")) "Jean-Luc"))
-  (assert (eq NIL (find-person 'firstname "J-Lu"))))
-
-;; Throw away the previous prevalence instance and start over,
-;; counting on a restore operation using the snapshot
-
-(close-open-streams *test-system*)
-(setf *test-system* (make-prevalence-system *test-system-directory*))
-
-(let ((person (find-object-with-id *test-system* 'person *jlp*)))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Jean-Luc"))
-  (assert (equal (get-lastname person) "Picard"))
-  (assert (equal (get-lastname (find-person 'firstname "Jean-Luc")) "Picard"))
-  (setf (get-firstname (find-person 'lastname "Picard")) "J-Lu")
-  (assert (equal (get-lastname (find-person 'firstname "J-Lu")) "Picard"))
-  (setf (get-firstname (find-person 'firstname "J-Lu")) "Jean-Luc")
-  (assert (equal (get-firstname (find-person 'lastname "Picard")) "Jean-Luc"))
-  (assert (eq NIL (find-person 'firstname "J-Lu"))))
-
-;; Create another test person
+(test test-find-managed-person-restart-snapshot
+  "Throw away the previous prevalence instance and start over,
+  counting on a restore operation using the snapshot"
+  (close-open-streams *test-system*)
+  (setf *test-system* (make-prevalence-system *test-system-directory*))
+  (let ((managed-person (find-object-with-id *test-system* 'managed-person *jlp*)))
+    (is (eq (class-of managed-person) (find-class 'managed-person)))
+    (is (equal (get-firstname managed-person) "Jean-Luc"))
+    (is (equal (get-lastname managed-person) "Picard"))
+    (is (equal (get-lastname (find-managed-person 'firstname "Jean-Luc")) "Picard"))
+    (setf (get-firstname (find-managed-person 'lastname "Picard")) "J-Lu")
+    (is (equal (get-lastname (find-managed-person 'firstname "J-Lu")) "Picard"))
+    (setf (get-firstname (find-managed-person 'firstname "J-Lu")) "Jean-Luc")
+    (is (equal (get-firstname (find-managed-person 'lastname "Picard")) "Jean-Luc"))
+    (is (eq NIL (find-managed-person 'firstname "J-Lu")))))
 
 (defvar *kj*)
 
-(let ((person (make-person 'firstname "Kathryn" 'lastname "Janeway")))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Kathryn"))
-  (assert (equal (get-lastname person) "Janeway"))
-  (assert (equal (get-firstname (find-person 'lastname "Janeway")) "Kathryn"))
-  (assert (equal (get-lastname (find-person 'firstname "Kathryn")) "Janeway"))
-  (setf *kj* (get-id person)))
+(test test-create-managed-person-1
+  "Create another test managed-person"
+  (let ((managed-person (make-managed-person 'firstname "Kathryn" 'lastname "Janeway")))
+    (is (eq (class-of managed-person) (find-class 'managed-person)))
+    (is (equal (get-firstname managed-person) "Kathryn"))
+    (is (equal (get-lastname managed-person) "Janeway"))
+    (is (equal (get-firstname (find-managed-person 'lastname "Janeway")) "Kathryn"))
+    (is (equal (get-lastname (find-managed-person 'firstname "Kathryn")) "Janeway"))
+    (setf *kj* (get-id managed-person))))
 
-(let ((person (find-object-with-id *test-system* 'person *kj*)))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Kathryn"))
-  (assert (equal (get-lastname person) "Janeway"))
-  (assert (equal (get-firstname (find-person 'lastname "Janeway")) "Kathryn"))
-  (assert (equal (get-lastname (find-person 'firstname "Kathryn")) "Janeway")))
+(test test-find-managed-person-1
+  (let ((managed-person (find-object-with-id *test-system* 'managed-person *kj*)))
+    (is (eq (class-of managed-person) (find-class 'managed-person)))
+    (is (equal (get-firstname managed-person) "Kathryn"))
+    (is (equal (get-lastname managed-person) "Janeway"))
+    (is (equal (get-firstname (find-managed-person 'lastname "Janeway")) "Kathryn"))
+    (is (equal (get-lastname (find-managed-person 'firstname "Kathryn")) "Janeway"))))
 
-;; Throw away the previous prevalence instance and start over,
-;; counting on a restore operation using both the snapshot and the transaction log
+(test test-find-managed-person-restart-1
+  "Throw away the previous prevalence instance and start over,
+   counting on a restore operation using both the snapshot and the transaction log"
+  (close-open-streams *test-system*)
+  (setf *test-system* (make-prevalence-system *test-system-directory*))
+  (let ((managed-person (find-object-with-id *test-system* 'managed-person *jlp*)))
+    (is (eq (class-of managed-person) (find-class 'managed-person)))
+    (is (equal (get-firstname managed-person) "Jean-Luc"))
+    (is (equal (get-lastname managed-person) "Picard"))
+    (is (equal (get-lastname (find-managed-person 'firstname "Jean-Luc")) "Picard"))
+    (setf (get-firstname (find-managed-person 'lastname "Picard")) "J-Lu")
+    (is (equal (get-lastname (find-managed-person 'firstname "J-Lu")) "Picard"))
+    (setf (get-firstname (find-managed-person 'firstname "J-Lu")) "Jean-Luc")
+    (is (equal (get-firstname (find-managed-person 'lastname "Picard")) "Jean-Luc"))
+    (is (eq NIL (find-managed-person 'firstname "J-Lu")))))
 
-(close-open-streams *test-system*)
-(setf *test-system* (make-prevalence-system *test-system-directory*))
+(test test-find-managed-person-restart-2
+  (let ((managed-person (find-object-with-id *test-system* 'managed-person *kj*)))
+    (is (eq (class-of managed-person) (find-class 'managed-person)))
+    (is (equal (get-firstname managed-person) "Kathryn"))
+    (is (equal (get-lastname managed-person) "Janeway"))
+    (is (equal (get-firstname (find-managed-person 'lastname "Janeway")) "Kathryn"))
+    (is (equal (get-lastname (find-managed-person 'firstname "Kathryn")) "Janeway"))))
 
-(let ((person (find-object-with-id *test-system* 'person *jlp*)))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Jean-Luc"))
-  (assert (equal (get-lastname person) "Picard"))
-  (assert (equal (get-lastname (find-person 'firstname "Jean-Luc")) "Picard"))
-  (setf (get-firstname (find-person 'lastname "Picard")) "J-Lu")
-  (assert (equal (get-lastname (find-person 'firstname "J-Lu")) "Picard"))
-  (setf (get-firstname (find-person 'firstname "J-Lu")) "Jean-Luc")
-  (assert (equal (get-firstname (find-person 'lastname "Picard")) "Jean-Luc"))
-  (assert (eq NIL (find-person 'firstname "J-Lu"))))
+(test test-managed-person-count
+  (mapcar #'(lambda (pair)
+	      (make-managed-person 'firstname (first pair) 'lastname (second pair)))
+	  '(("Benjamin" "Sisko") ("James T." "Kirk") ("Jonathan" "Archer")))
+  (is (= (length (find-all-objects *test-system* 'managed-person)) 5))
+  (mapcar #'(lambda (pair)
+	      (delete-managed-person (find-managed-person 'firstname (first pair))))
+	  '(("Benjamin" "Sisko") ("James T." "Kirk") ("Jonathan" "Archer")))
+  (is (= (length (find-all-objects *test-system* 'managed-person)) 2)))
 
-(let ((person (find-object-with-id *test-system* 'person *kj*)))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Kathryn"))
-  (assert (equal (get-lastname person) "Janeway"))
-  (assert (equal (get-firstname (find-person 'lastname "Janeway")) "Kathryn"))
-  (assert (equal (get-lastname (find-person 'firstname "Kathryn")) "Janeway")))
+(defvar *managed-guard*)
 
-(mapcar #'(lambda (pair)
-           (make-person 'firstname (first pair) 'lastname (second pair)))
-	'(("Benjamin" "Sisko") ("James T." "Kirk") ("Jonathan" "Archer")))
-
-(assert (= (length (find-all-objects *test-system* 'person)) 5))
-
-
-;;; testing a guarded prevalence system
-;;; [Not sure that we need the below test here -- RRR]
-
-(defvar *guard*)
-
-(defun guard (thunk)
-  (setf *guard* t)
+(defun managed-guard (thunk)
+  (setf *managed-guard* t)
   (funcall thunk))
 
-(close-open-streams *test-system*)
-(setf *test-system* (make-prevalence-system *test-system-directory* 
+(test test-managed-guarded
+  "testing a managed-guarded prevalence system
+   [Not sure that we need the below test here -- RRR]"
+  (close-open-streams *test-system*)
+  (setf *test-system* (make-prevalence-system *test-system-directory* 
                                             :prevalence-system-class 'guarded-prevalence-system))
-(setf (get-guard *test-system*) #'guard)
-
-(let (new-person)
-  (setf *guard* nil)
-  (setf new-person (make-person 'firstname "John" 'lastname "Doe"))
-  (assert *guard*)
-  (setf *guard* nil)
-  (delete-person new-person)
-  (assert *guard*))
+  (setf (get-guard *test-system*) #'managed-guard)
+  (let (new-managed-person)
+    (setf *managed-guard* nil)
+    (setf new-managed-person (make-managed-person 'firstname "John" 'lastname "Doe"))
+    (is-true *managed-guard*)
+    (setf *managed-guard* nil)
+    (delete-managed-person new-managed-person)
+    (is-true *managed-guard*)))
 
 ;;; eof

test/test-master-slave.lisp

 ;;;; as governed by the terms of the Lisp Lesser General Public License
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 
-(in-package :cl-prevalence)
+(in-package :cl-prevalence-test)
+
+(def-suite test-master-slave)
+
+(in-suite test-master-slave)
 
 ;; the master and client systems themselves
 
   ((username :accessor get-username :initarg :username :initform nil)
    (password :accessor get-password :initarg :password :initform nil)))
 
-;; setup both systems (clearing anything we find)
-
-(when *master-test-system* 
-  (totally-destroy *master-test-system*))
-
-(setf *master-test-system* (make-prevalence-system *master-test-system-directory*))
-(totally-destroy *master-test-system*)
-(execute-transaction (tx-create-id-counter *master-test-system*))
-
-(when *slave-test-system* 
-  (totally-destroy *slave-test-system*))
-
-(setf *slave-test-system* (make-prevalence-system *slave-test-system-directory*))
-(totally-destroy *slave-test-system*)
-(execute-transaction (tx-create-id-counter *slave-test-system*))
-
-;; setup the slave server and the master to slave connection
-
 (defvar *slave-server-name* nil)
 
-(setf *slave-server-name* (start-slave-server *slave-test-system*))
-
-(start-master-client *master-test-system*)
-
-;; now do the test
-
 (defvar *user-id* nil)
 
-(let ((user (execute-transaction (tx-create-object *master-test-system* 
+(test test-master-slave-start
+  "setup both systems (clearing anything we find)
+  setup the slave server and the master to slave connection"
+  (when *master-test-system* 
+    (totally-destroy *master-test-system*))
+
+  (setf *master-test-system* (make-prevalence-system *master-test-system-directory*))
+  (is-true *master-test-system*)
+  (totally-destroy *master-test-system*)
+  (execute-transaction (tx-create-id-counter *master-test-system*))
+
+  (when *slave-test-system* 
+    (totally-destroy *slave-test-system*))
+  (setf *slave-test-system* (make-prevalence-system *slave-test-system-directory*))
+  (is-true *slave-test-system*)
+  (totally-destroy *slave-test-system*)
+  (execute-transaction (tx-create-id-counter *slave-test-system*))
+  (setf *slave-server-name* (start-slave-server *slave-test-system*))
+  (is-true *slave-server-name*)
+
+  (start-master-client *master-test-system*)
+  (let ((user (execute-transaction (tx-create-object *master-test-system* 
                                                    'test-system-user
                                                    '((username "billg")
                                                      (password "windows"))))))
-  (setf *user-id* (get-id user)))
+    (setf *user-id* (get-id user)))
+  (is-true *user-id*)
+  *user-id*
+  )
+;; now do the test
 
-*user-id*
+(test test-get-master-user
+  (let ((user (find-object-with-id *master-test-system* 'test-system-user *user-id*)))
+    (is (and (equal (get-username user) "billg")
+	     (equal (get-password user) "windows")))))
 
-(let ((user (find-object-with-id *master-test-system* 'test-system-user *user-id*)))
-  (assert (and (equal (get-username user) "billg")
-               (equal (get-password user) "windows"))))
+(test test-get-slave-user :depends-on '(and test-get-master-user)
+      ;; Plato Wu,2009/02/27: because it need time to transfer data from master to slave?
+      (sleep 1)
+      (let ((user (find-object-with-id *slave-test-system* 'test-system-user *user-id*)))
+	(is (and (equal (get-username user) "billg")
+		 (equal (get-password user) "windows")))))
 
-(sleep 1)
+(test test-master-slave-end
+ " stop the master-slave connection and slave server
+  tidy up a bit"
+ (stop-master-client *master-test-system*)
+ (stop-slave-server *slave-server-name*)
 
-(let ((user (find-object-with-id *slave-test-system* 'test-system-user *user-id*)))
-  (assert (and (equal (get-username user) "billg")
-               (equal (get-password user) "windows"))))
-
-;; stop the master-slave connection and slave server
-
-(stop-master-client *master-test-system*)
-(stop-slave-server *slave-server-name*)
-
-;; tidy up a bit
-
-(close-open-streams *master-test-system*)
-(close-open-streams *slave-test-system*)
-
+ (close-open-streams *master-test-system*)
+ (close-open-streams *slave-test-system*)
+ )
 ;;;; eof

test/test-prevalence.lisp

 ;;;; as governed by the terms of the Lisp Lesser General Public License
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 
-(in-package :cl-prevalence)
+(in-package :cl-prevalence-test)
+
+(def-suite test-prevalence)
+
+(in-suite test-prevalence)
 
 (defparameter *test-system-directory* (pathname "/tmp/test-prevalence-system/"))
 
 (defvar *test-system* nil)
 
-;; Create a new prevalence system for testing purposes
-
-(let ((directory *test-system-directory*))
-  ;; Throw away any xml files that we find: we want to start from scratch
-  (when (probe-file directory)
-    (dolist (pathname (directory (merge-pathnames "*.xml" directory)))
-      (delete-file pathname)))
-  (setf *test-system* (make-prevalence-system directory)))
-
+(test test-prevalence-start
+ "Create a new prevalence system for testing purposes"
+ (let ((directory *test-system-directory*))
+   ;; Throw away any xml files that we find: we want to start from scratch
+   (when (probe-file directory)
+     (dolist (pathname (directory (merge-pathnames "*.xml" directory)))
+       (delete-file pathname)))
+   (setf *test-system* (make-prevalence-system directory))
+   (is-true *test-system*)))
 ;; A Test CLOS class
 
 (defclass person ()
   (let ((persons (get-root-object system :persons)))
     (remhash id persons)))
 
-;; Create a new id counter
+(test create-counter
+  "Test create a new id counter"
+  (execute *test-system* (make-transaction 'tx-create-id-counter))
+  (is (zerop (get-root-object *test-system* :id-counter))))
 
-(execute *test-system* (make-transaction 'tx-create-id-counter))
-
-(assert (zerop (get-root-object *test-system* :id-counter)))
-
-;; Create the hash-table holding all known persistent persons and mapping person id' to person objects
-
-(execute *test-system* (make-transaction 'tx-create-persons-root))
-
-(assert (hash-table-p (get-root-object *test-system* :persons)))
+(test hash-table-test
+  "Create the hash-table holding all known persistent persons and mapping person id' to person objects"
+  (execute *test-system* (make-transaction 'tx-create-persons-root))  
+  (is (hash-table-p (get-root-object *test-system* :persons))))
 
 ;; A place to store our test person's id outside of the system
-
 (defvar *jlp*)
 
-;; Create a new test person
+(test test-create-person
+  "Create a new test person"
+  (let
+      ((person (execute *test-system* (make-transaction 'tx-create-person "Jean-Luc" "Picard"))))
+    (is (eq (class-of person) (find-class 'person)))
+    (is (equal (get-firstname person) "Jean-Luc"))
+    (is (equal (get-lastname person) "Picard"))
+    (setf *jlp* (get-id person))))
 
-(let ((person (execute *test-system* (make-transaction 'tx-create-person "Jean-Luc" "Picard"))))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Jean-Luc"))
-  (assert (equal (get-lastname person) "Picard"))
-  (setf *jlp* (get-id person)))
+(test test-get-person :depends-on '(and test-create-person)
+    (let ((person (gethash *jlp* (get-root-object *test-system* :persons))))
+      (is (eq (class-of person) (find-class 'person)))
+      (is (equal (get-firstname person) "Jean-Luc"))
+      (is (equal (get-lastname person) "Picard"))))
 
-(let ((person (gethash *jlp* (get-root-object *test-system* :persons))))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Jean-Luc"))
-  (assert (equal (get-lastname person) "Picard")))
+(test test-get-person-restart
+  "Throw away the previous prevalence instance and start over,
+   counting on a restore operation using the transaction log"
+  (close-open-streams *test-system*)
+  (setf *test-system* (make-prevalence-system *test-system-directory*))
+  (let ((person (gethash *jlp* (get-root-object *test-system* :persons))))
+   (is (eq (class-of person) (find-class 'person)))
+   (is (equal (get-firstname person) "Jean-Luc"))
+   (is (equal (get-lastname person) "Picard"))))
 
-;; Throw away the previous prevalence instance and start over,
-;; counting on a restore operation using the transaction log
+(test test-get-person-snapshot
+  "Create a snapshot of our test system"
+  (snapshot *test-system*)
+  (let ((person (gethash *jlp* (get-root-object *test-system* :persons))))
+   (is (eq (class-of person) (find-class 'person)))
+   (is (equal (get-firstname person) "Jean-Luc"))
+   (is (equal (get-lastname person) "Picard"))))
 
-(close-open-streams *test-system*)
-(setf *test-system* (make-prevalence-system *test-system-directory*))
-
-(let ((person (gethash *jlp* (get-root-object *test-system* :persons))))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Jean-Luc"))
-  (assert (equal (get-lastname person) "Picard")))
-
-;; Create a snapshot of our test system
-
-(snapshot *test-system*)
-
-(let ((person (gethash *jlp* (get-root-object *test-system* :persons))))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Jean-Luc"))
-  (assert (equal (get-lastname person) "Picard")))
-
-;; Throw away the previous prevalence instance and start over,
-;; counting on a restore operation using the snapshot
-
-(close-open-streams *test-system*)
-(setf *test-system* (make-prevalence-system *test-system-directory*))
-
-(let ((person (gethash *jlp* (get-root-object *test-system* :persons))))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Jean-Luc"))
-  (assert (equal (get-lastname person) "Picard")))
+(test test-get-person-restart-snapshot
+  "Throw away the previous prevalence instance and start over,
+   counting on a restore operation using the snapshot"
+  (close-open-streams *test-system*)
+  (setf *test-system* (make-prevalence-system *test-system-directory*))
+  (let ((person (gethash *jlp* (get-root-object *test-system* :persons))))
+   (is (eq (class-of person) (find-class 'person)))
+   (is (equal (get-firstname person) "Jean-Luc"))
+   (is (equal (get-lastname person) "Picard"))))
 
 ;; Create another test person
 
 (defvar *kj*)
 
-(let ((person (execute *test-system* (make-transaction 'tx-create-person "Kathryn" "Janeway"))))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Kathryn"))
-  (assert (equal (get-lastname person) "Janeway"))
-  (setf *kj* (get-id person)))
+(test test-create-person-1
+    (let ((person (execute *test-system* (make-transaction 'tx-create-person "Kathryn" "Janeway"))))
+   (is (eq (class-of person) (find-class 'person)))
+   (is (equal (get-firstname person) "Kathryn"))
+   (is (equal (get-lastname person) "Janeway"))
+   (setf *kj* (get-id person))))
 
-(let ((person (gethash *kj* (get-root-object *test-system* :persons))))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Kathryn"))
-  (assert (equal (get-lastname person) "Janeway")))
+(test test-get-person-1
+  (let ((person (gethash *kj* (get-root-object *test-system* :persons))))
+   (is (eq (class-of person) (find-class 'person)))
+   (is (equal (get-firstname person) "Kathryn"))
+   (is (equal (get-lastname person) "Janeway"))))
 
-;; Throw away the previous prevalence instance and start over,
-;; counting on a restore operation using both the snapshot and the transaction log
+(test test-get-person-restart-1
+  "Throw away the previous prevalence instance and start over,
+  counting on a restore operation using both the snapshot and the transaction log"
+  (close-open-streams *test-system*)
+  (setf *test-system* (make-prevalence-system *test-system-directory*))
+  (let ((person (gethash *jlp* (get-root-object *test-system* :persons))))
+   (is (eq (class-of person) (find-class 'person)))
+   (is (equal (get-firstname person) "Jean-Luc"))
+   (is (equal (get-lastname person) "Picard"))))
 
-(close-open-streams *test-system*)
-(setf *test-system* (make-prevalence-system *test-system-directory*))
+(test test-get-person-restart-2
+  (let ((person (gethash *kj* (get-root-object *test-system* :persons))))
+   (is (eq (class-of person) (find-class 'person)))
+   (is (equal (get-firstname person) "Kathryn"))
+   (is (equal (get-lastname person) "Janeway"))))
 
-(let ((person (gethash *jlp* (get-root-object *test-system* :persons))))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Jean-Luc"))
-  (assert (equal (get-lastname person) "Picard")))
-
-(let ((person (gethash *kj* (get-root-object *test-system* :persons))))
-  (assert (eq (class-of person) (find-class 'person)))
-  (assert (equal (get-firstname person) "Kathryn"))
-  (assert (equal (get-lastname person) "Janeway")))
-
-(mapcar #'(lambda (pair)
+(test test-person-count
+  (mapcar #'(lambda (pair)
 	    (execute *test-system* (make-transaction 'tx-create-person (car pair) (cadr pair))))
 	'(("Benjamin" "Sisko") ("James T." "Kirk") ("Jonathan" "Archer")))
-
-(assert (= (hash-table-count (get-root-object *test-system* :persons)) 5))
-
-;;; testing a guarded prevalence system
+  (is (= (hash-table-count (get-root-object *test-system* :persons)) 5))
+  (mapcar #'(lambda (id)
+	      (execute *test-system* (make-transaction 'tx-delete-person id)))
+	  '(2 3 4))
+  (is (= (hash-table-count (get-root-object *test-system* :persons)) 2)))
 
 (defvar *guard*)
 
   (setf *guard* t)
   (funcall thunk))
 
-(close-open-streams *test-system*)
-(setf *test-system* (make-prevalence-system *test-system-directory* 
+(test test-guarded
+  "testing a guarded prevalence system"
+  (close-open-streams *test-system*)
+  (setf *test-system* (make-prevalence-system *test-system-directory* 
                                             :prevalence-system-class 'guarded-prevalence-system))
-(setf (get-guard *test-system*) #'guard)
-
-(let (new-person)
-  (setf *guard* nil)
-  (setf new-person (execute *test-system* (make-transaction 'tx-create-person "John" "Doe")))
-  (assert *guard*)
-  (setf *guard* nil)
-  (execute *test-system* (make-transaction 'tx-delete-person (get-id new-person)))
-  (assert *guard*))
+  (setf (get-guard *test-system*) #'guard)
+  (let (new-person)
+   (setf *guard* nil)
+   (setf new-person (execute *test-system* (make-transaction 'tx-create-person "John" "Doe")))
+   (is-true *guard*)
+   (setf *guard* nil)
+   (execute *test-system* (make-transaction 'tx-delete-person (get-id new-person)))
+   (is-true *guard*)))
 
 ;;; eof

test/test-serialization.lisp

 ;;;; as governed by the terms of the Lisp Lesser General Public License
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 
-(in-package :s-serialization)
+(in-package :cl-prevalence-test)
+
+(def-suite test-serialization)
+
+(in-suite test-serialization)
 
 (defun serialize-and-deserialize-xml (object)
   (with-input-from-string
 
 ;; primitives
 
-(assert
- (null (serialize-and-deserialize-xml nil)))
+(test test-primitive-1
+  (is
+   (null (serialize-and-deserialize-xml nil))))
 
-(assert
- (null (serialize-and-deserialize-sexp nil)))
+(test test-primitive-2
+  (is
+   (null (serialize-and-deserialize-sexp nil))))
 
-(assert
- (eq (serialize-and-deserialize-xml t)
-     t))
+(test test-primitive-3
+  (is
+   (eq (serialize-and-deserialize-xml t)
+       t)))
 
-(assert
- (eq (serialize-and-deserialize-sexp t)
-     t))
+(test test-primitive-4
+  (is
+   (eq (serialize-and-deserialize-sexp t)
+       t)))
 
-(assert
- (= (serialize-and-deserialize-xml 100)
-    100))
+(test test-primitive-5
+  (is
+   (= (serialize-and-deserialize-xml 100)
+      100)))
 
-(assert
- (= (serialize-and-deserialize-sexp 100)
-    100))
+(test test-primitive-6
+  (is
+   (= (serialize-and-deserialize-sexp 100)
+      100)))
 
-(assert
- (= (serialize-and-deserialize-xml (/ 3))
-    (/ 3)))
+(test test-primitive-7
+  (is
+   (= (serialize-and-deserialize-xml (/ 3))
+      (/ 3))))
 
-(assert
- (= (serialize-and-deserialize-sexp (/ 3))
-    (/ 3)))
+(test test-primitive-8
+  (is
+   (= (serialize-and-deserialize-sexp (/ 3))
+      (/ 3))))
 
-(assert
- (= (serialize-and-deserialize-xml pi)
-    pi))
+(test test-primitive-9
+  (is
+   (= (serialize-and-deserialize-xml pi)
+      pi)))
 
-(assert
- (= (serialize-and-deserialize-sexp pi)
-    pi))
+(test test-primitive-10
+  (is
+   (= (serialize-and-deserialize-sexp pi)
+      pi)))
 
-(assert
- (= (serialize-and-deserialize-xml (complex 1.5 2.5))
-    (complex 1.5 2.5)))
+(test test-primitive-11
+  (is
+   (= (serialize-and-deserialize-xml (complex 1.5 2.5))
+      (complex 1.5 2.5))))
 
-(assert
- (= (serialize-and-deserialize-sexp (complex 1.5 2.5))
-    (complex 1.5 2.5)))
+(test test-primitive-12
+  (is
+   (= (serialize-and-deserialize-sexp (complex 1.5 2.5))
+      (complex 1.5 2.5))))
 
-(assert
- (eq (serialize-and-deserialize-xml 'foo)
-     'foo))
+(test test-primitive-13
+  (is
+   (eq (serialize-and-deserialize-xml 'foo)
+       'foo)))
 
-(assert
- (eq (serialize-and-deserialize-sexp 'foo)
-     'foo))
+(test test-primitive-14
+  (is
+   (eq (serialize-and-deserialize-sexp 'foo)
+       'foo)))
 
-(assert
- (eq (serialize-and-deserialize-xml :foo)
-     :foo))
+(test test-primitive-15
+  (is
+   (eq (serialize-and-deserialize-xml :foo)
+       :foo)))
 
-(assert
- (eq (serialize-and-deserialize-sexp :foo)
-     :foo))
+(test test-primitive-16
+  (is
+   (eq (serialize-and-deserialize-sexp :foo)
+       :foo)))
 
-(assert
- (eq (serialize-and-deserialize-xml 'room)
-     'room))
+(test test-primitive-17
+  (is
+   (eq (serialize-and-deserialize-xml 'room)
+       'room)))
 
-(assert
- (eq (serialize-and-deserialize-sexp 'room)
-     'room))
+(test test-primitive-18
+  (is
+   (eq (serialize-and-deserialize-sexp 'room)
+       'room)))
 
-(assert
- (eq (serialize-and-deserialize-xml '|Unprintable|)
-     '|Unprintable|))
+(test test-primitive-19
+  (is
+   (eq (serialize-and-deserialize-xml '|Unprintable|)
+       '|Unprintable|)))
 
-(assert
- (eq (serialize-and-deserialize-sexp '|Unprintable|)
-     '|Unprintable|))
+(test test-primitive-20
+  (is
+   (eq (serialize-and-deserialize-sexp '|Unprintable|)
+       '|Unprintable|)))
 
-(assert
- (equal (serialize-and-deserialize-xml "Hello")
-	"Hello"))
+(test test-primitive-21
+  (is
+   (equal (serialize-and-deserialize-xml "Hello")
+	  "Hello")))
 
-(assert
- (equal (serialize-and-deserialize-sexp "Hello")
-	"Hello"))
+(test test-primitive-22
+  (is
+   (equal (serialize-and-deserialize-sexp "Hello")
+	  "Hello")))
 
-(assert 
- (equal (serialize-and-deserialize-xml "")
-        ""))
+(test test-primitive-23
+  (is 
+   (equal (serialize-and-deserialize-xml "")
+	  "")))
 
-(assert 
- (equal (serialize-and-deserialize-sexp "")
-        ""))
+(test test-primitive-24
+  (is 
+   (equal (serialize-and-deserialize-sexp "")
+	  "")))
 
-(assert
- (equal (serialize-and-deserialize-xml #\A)
-        #\A))
+(test test-primitive-25
+  (is
+   (equal (serialize-and-deserialize-xml #\A)
+	  #\A)))
 
-(assert
- (equal (serialize-and-deserialize-sexp #\A)
-        #\A))
+(test test-primitive-26
+  (is
+   (equal (serialize-and-deserialize-sexp #\A)
+	  #\A)))
 
-(assert
- (equal (serialize-and-deserialize-xml #\<)
-        #\<))
+(test test-primitive-27
+  (is
+   (equal (serialize-and-deserialize-xml #\<)
+	  #\<)))
 
-(assert
- (equal (serialize-and-deserialize-sexp #\<)
-        #\<))
+(test test-primitive-28
+  (is
+   (equal (serialize-and-deserialize-sexp #\<)
+	  #\<)))
 
-(assert
- (equal (serialize-and-deserialize-xml "Hello <foo> & </bar>!")
-	"Hello <foo> & </bar>!"))
+(test test-primitive-29
+  (is
+   (equal (serialize-and-deserialize-xml "Hello <foo> & </bar>!")
+	  "Hello <foo> & </bar>!")))
 
-(assert
- (equal (serialize-and-deserialize-sexp "Hello <foo> & </bar>!")
-	"Hello <foo> & </bar>!"))
+(test test-primitive-30
+  (is
+   (equal (serialize-and-deserialize-sexp "Hello <foo> & </bar>!")
+	  "Hello <foo> & </bar>!")))
 
 ;; simple sequences
 
-(assert
- (reduce #'(lambda (x &optional (y t)) (and x y))
-	 (map 'list
-	      #'eql
-	      (serialize-and-deserialize-xml (list 1 2 3))
-	      (list 1 2 3))))
+(test test-simple-sequences-1
+  (is
+   (reduce #'(lambda (x &optional (y t)) (and x y))
+	   (map 'list
+		#'eql
+		(serialize-and-deserialize-xml (list 1 2 3))
+		(list 1 2 3)))))
 
-(assert
- (reduce #'(lambda (x &optional (y t)) (and x y))
-	 (map 'list
-	      #'eql
-	      (serialize-and-deserialize-sexp (list 1 2 3))
-	      (list 1 2 3))))
+(test test-simple-sequences-2
+  (is
+   (reduce #'(lambda (x &optional (y t)) (and x y))
+	   (map 'list
+		#'eql
+		(serialize-and-deserialize-sexp (list 1 2 3))
+		(list 1 2 3)))))
 
-(assert
- (equal (serialize-and-deserialize-xml (list 1 2 3))
-	(list 1 2 3)))
+(test test-simple-sequences-3
+  (is
+   (equal (serialize-and-deserialize-xml (list 1 2 3))
+	  (list 1 2 3))))
 
-(assert
- (equal (serialize-and-deserialize-sexp (list 1 2 3))
-	(list 1 2 3)))
+(test test-simple-sequences-4
+  (is
+   (equal (serialize-and-deserialize-sexp (list 1 2 3))
+	  (list 1 2 3))))
 
-(assert
- (equal (serialize-and-deserialize-xml (cons 1 2))
-        (cons 1 2)))
+(test test-simple-sequences-5
+  (is
+   (equal (serialize-and-deserialize-xml (cons 1 2))
+	  (cons 1 2))))
 
-(assert
- (equal (serialize-and-deserialize-sexp (cons 1 2))
-        (cons 1 2)))
+(test test-simple-sequences-6
+  (is
+   (equal (serialize-and-deserialize-sexp (cons 1 2))
+	  (cons 1 2))))
 
-(assert 
- (equal (serialize-and-deserialize-xml '(1 2 3 4 5 6 7 8 9 . 0))
-        '(1 2 3 4 5 6 7 8 9 . 0)))
+(test test-simple-sequences-7
+  (is 
+   (equal (serialize-and-deserialize-xml '(1 2 3 4 5 6 7 8 9 . 0))
+	  '(1 2 3 4 5 6 7 8 9 . 0))))
 
-(assert 
- (equal (serialize-and-deserialize-sexp '(1 2 3 4 5 6 7 8 9 . 0))
-        '(1 2 3 4 5 6 7 8 9 . 0)))
+(test test-simple-sequences-8
+  (is 
+   (equal (serialize-and-deserialize-sexp '(1 2 3 4 5 6 7 8 9 . 0))
+	  '(1 2 3 4 5 6 7 8 9 . 0))))
 
-(assert
- (equal (serialize-and-deserialize-xml (cons 'hi 2))
-	(cons 'hi 2)))
+(test test-simple-sequences-9
+  (is
+   (equal (serialize-and-deserialize-xml (cons 'hi 2))
+	  (cons 'hi 2))))
 
-(assert
- (equal (serialize-and-deserialize-sexp (cons 'hi 2))
-	(cons 'hi 2)))
+(test test-simple-sequences-10
+  (is
+   (equal (serialize-and-deserialize-sexp (cons 'hi 2))
+	  (cons 'hi 2))))
 
 (defun circular-list (&rest elements)
    (let ((cycle (copy-list elements))) 
      (nconc cycle cycle)))
 
-(assert
- (equal (third (serialize-and-deserialize-sexp (circular-list 'a 'b)))
-        'a))
-(assert
- (equal (third (serialize-and-deserialize-xml (circular-list 'a 'b)))
-        'a))
+(test test-circular-list-1
+  (is
+   (equal (third (serialize-and-deserialize-sexp (circular-list 'a 'b)))
+	  'a)))
 
-(assert
- (equal (serialize-and-deserialize-xml (cons 'hi 2))
-	(cons 'hi 2)))
+(test test-circular-list-2
+  (is
+   (equal (third (serialize-and-deserialize-xml (circular-list 'a 'b)))
+	  'a)))
 
-(assert
- (equal (serialize-and-deserialize-sexp (cons 'hi 2))
-	(cons 'hi 2)))
+(test test-circular-list-3
+  (is
+   (equal (serialize-and-deserialize-xml (cons 'hi 2))
+	  (cons 'hi 2))))
 
-(assert
- (equal (third (serialize-and-deserialize-sexp (circular-list 'a 'b)))
-        'a))
-(assert
- (equal (third (serialize-and-deserialize-xml (circular-list 'a 'b)))
-        'a))
+(test test-circular-list-4
+  (is
+   (equal (serialize-and-deserialize-sexp (cons 'hi 2))
+	  (cons 'hi 2))))
+
+(test test-circular-list-5
+  (is
+   (equal (third (serialize-and-deserialize-sexp (circular-list 'a 'b)))
+	  'a)))
+
+(test test-circular-list-6
+  (is
+   (equal (third (serialize-and-deserialize-xml (circular-list 'a 'b)))
+	  'a)))
 
 ;; simple objects
 
 
 (defparameter *foobar* (make-instance 'foobar :foo 100 :bar "Bar"))
 
-(assert
- (let ((foobar (serialize-and-deserialize-xml *foobar*)))
-   (and (equal (get-foo foobar) (get-foo *foobar*))
-	(equal (get-bar foobar) (get-bar *foobar*))
-	(eq (class-of foobar) (class-of *foobar*)))))
+(test test-simple-objects-1
+  (let ((foobar (serialize-and-deserialize-xml *foobar*)))
+    (is (and (equal (get-foo foobar) (get-foo *foobar*))
+	     (equal (get-bar foobar) (get-bar *foobar*))
+	     (eq (class-of foobar) (class-of *foobar*))))))
 
-(assert
- (let ((foobar (serialize-and-deserialize-sexp *foobar*)))
-   (and (equal (get-foo foobar) (get-foo *foobar*))
-	(equal (get-bar foobar) (get-bar *foobar*))
-	(eq (class-of foobar) (class-of *foobar*)))))
+(test test-simple-objects-2
+  (let ((foobar (serialize-and-deserialize-sexp *foobar*)))
+    (is (and (equal (get-foo foobar) (get-foo *foobar*))
+	     (equal (get-bar foobar) (get-bar *foobar*))
+	     (eq (class-of foobar) (class-of *foobar*))))))
 
 ;; standard structs
 
 
 (defparameter *foobaz* (make-foobaz :foo 100 :baz "Baz"))
 
-(assert
- (let ((foobaz (serialize-and-deserialize-xml *foobaz*)))
-   (and (foobaz-p foobaz)
-	(equal (foobaz-foo foobaz) (foobaz-foo *foobaz*))
-	(equal (foobaz-baz foobaz) (foobaz-baz *foobaz*)))))
+(test test-standard-structs-1
+  (let ((foobaz (serialize-and-deserialize-xml *foobaz*)))
+    (is (and (foobaz-p foobaz)
+	     (equal (foobaz-foo foobaz) (foobaz-foo *foobaz*))
+	     (equal (foobaz-baz foobaz) (foobaz-baz *foobaz*))))))
 
-(assert
- (let ((foobaz (serialize-and-deserialize-sexp *foobaz*)))
-   (and (foobaz-p foobaz)
-	(equal (foobaz-foo foobaz) (foobaz-foo *foobaz*))
-	(equal (foobaz-baz foobaz) (foobaz-baz *foobaz*)))))
+(test test-standard-structs-2
+  (let ((foobaz (serialize-and-deserialize-sexp *foobaz*)))
+    (is (and (foobaz-p foobaz)
+	     (equal (foobaz-foo foobaz) (foobaz-foo *foobaz*))
+	     (equal (foobaz-baz foobaz) (foobaz-baz *foobaz*))))))
 
 ;;; hash-tables
 
        *features*)
     hashtable))
 
-(let (h2)
-  (setf h2 (serialize-and-deserialize-xml *hashtable*))
-  (maphash #'(lambda (k v) (assert (equal v (gethash k h2)))) *hashtable*) 
-  (maphash #'(lambda (k v) (assert (equal v (gethash k *hashtable*)))) h2))
+(test test-hash-tables-1
+  (let (h2)
+    (setf h2 (serialize-and-deserialize-xml *hashtable*))
+    (maphash #'(lambda (k v) (is (equal v (gethash k h2)))) *hashtable*) 
+    (maphash #'(lambda (k v) (is (equal v (gethash k *hashtable*)))) h2)))
 
-(let (h2)
-  (setf h2 (serialize-and-deserialize-sexp *hashtable*))
-  (maphash #'(lambda (k v) (assert (equal v (gethash k h2)))) *hashtable*) 
-  (maphash #'(lambda (k v) (assert (equal v (gethash k *hashtable*)))) h2))
+(test test-hash-tables-2
+  (let (h2)
+    (setf h2 (serialize-and-deserialize-sexp *hashtable*))
+    (maphash #'(lambda (k v) (is (equal v (gethash k h2)))) *hashtable*) 
+    (maphash #'(lambda (k v) (is (equal v (gethash k *hashtable*)))) h2)))
 
 (defparameter *empty-hashtable* (make-hash-table))
 
-(let (h2)
-  (setf h2 (serialize-and-deserialize-xml *empty-hashtable*))
-  (maphash #'(lambda (k v) (assert (equal v (gethash k h2)))) *empty-hashtable*) 
-  (maphash #'(lambda (k v) (assert (equal v (gethash k *hashtable*)))) h2))
+(test test-empty-hash-tables-1
+  (let (h2)
+    (setf h2 (serialize-and-deserialize-xml *empty-hashtable*))
+    (maphash #'(lambda (k v) (is (equal v (gethash k h2)))) *empty-hashtable*) 
+    (maphash #'(lambda (k v) (is (equal v (gethash k *hashtable*)))) h2)))
 
-(let (h2)
-  (setf h2 (serialize-and-deserialize-sexp *empty-hashtable*))
-  (maphash #'(lambda (k v) (assert (equal v (gethash k h2)))) *empty-hashtable*) 
-  (maphash #'(lambda (k v) (assert (equal v (gethash k *hashtable*)))) h2))
+(test test-empty-hash-tables-2
+  (let (h2)
+    (setf h2 (serialize-and-deserialize-sexp *empty-hashtable*))
+    (maphash #'(lambda (k v) (is (equal v (gethash k h2)))) *empty-hashtable*) 
+    (maphash #'(lambda (k v) (is (equal v (gethash k *hashtable*)))) h2)))
+
 
 ;;; eof
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.