[cl-prevalence-cvs] CVS cl-prevalence/test

[scaekenberghe]

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 at 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 ()