Update of /project/cl-prevalence/cvsroot/cl-prevalence/test In directory common-lisp:/tmp/cvs-serv12214/test

Modified Files: test-prevalence.lisp test-serialization.lisp Log Message: added patches and tests contributed by Henrik Hjelte (henrik@evahjelte.com) to (de)serialize improper lists and conses

--- /project/cl-prevalence/cvsroot/cl-prevalence/test/test-prevalence.lisp 2004/10/05 11:35:30 1.3 +++ /project/cl-prevalence/cvsroot/cl-prevalence/test/test-prevalence.lisp 2006/01/31 12:41:48 1.4 @@ -1,6 +1,6 @@ ;;;; -*- mode: Lisp -*- ;;;; -;;;; $Id: test-prevalence.lisp,v 1.3 2004/10/05 11:35:30 scaekenberghe Exp $ +;;;; $Id: test-prevalence.lisp,v 1.4 2006/01/31 12:41:48 scaekenberghe Exp $ ;;;; ;;;; Testing Object Prevalence in Common Lisp ;;;; @@ -39,7 +39,7 @@

(defun tx-create-person (system firstname lastname) (let* ((persons (get-root-object system :persons)) - (id (tx-get-next-id system)) + (id (next-id system)) (person (make-instance 'person :id id :firstname firstname :lastname lastname))) (setf (gethash id persons) person)))

--- /project/cl-prevalence/cvsroot/cl-prevalence/test/test-serialization.lisp 2005/01/24 10:04:18 1.4 +++ /project/cl-prevalence/cvsroot/cl-prevalence/test/test-serialization.lisp 2006/01/31 12:41:48 1.5 @@ -1,6 +1,6 @@ ;;;; -*- mode: Lisp -*- ;;;; -;;;; $Id: test-serialization.lisp,v 1.4 2005/01/24 10:04:18 scaekenberghe Exp $ +;;;; $Id: test-serialization.lisp,v 1.5 2006/01/31 12:41:48 scaekenberghe Exp $ ;;;; ;;;; Testing XML and S-Expression based Serialization for Common Lisp and CLOS ;;;; @@ -168,6 +168,56 @@ (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))) + +(assert + (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))) + +(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))) + +(assert + (equal (serialize-and-deserialize-xml (cons 'hi 2)) + (cons 'hi 2))) + +(assert + (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)) + +(assert + (equal (serialize-and-deserialize-xml (cons 'hi 2)) + (cons 'hi 2))) + +(assert + (equal (serialize-and-deserialize-sexp (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)) + ;; simple objects

(defclass foobar ()