Update of /project/elephant/cvsroot/elephant/tests In directory common-lisp.net:/tmp/cvs-serv27992/tests
Modified Files: testserializer.lisp Log Message: buffer-streamified
Date: Thu Sep 16 06:27:19 2004 Author: blee
Index: elephant/tests/testserializer.lisp diff -u elephant/tests/testserializer.lisp:1.4 elephant/tests/testserializer.lisp:1.5 --- elephant/tests/testserializer.lisp:1.4 Sat Sep 4 11:16:11 2004 +++ elephant/tests/testserializer.lisp Thu Sep 16 06:27:19 2004 @@ -1,23 +1,23 @@ (in-package :ele-tests)
(defun in-out-value (var) - (serialize var *out-buf*) - (deserialize (buffer-stream-buffer *out-buf*))) + (with-buffer-streams (out-buf) + (deserialize (serialize var out-buf))))
(defun in-out-eq (var) - (serialize var *out-buf*) - (eq var (deserialize (buffer-stream-buffer *out-buf*)))) + (with-buffer-streams (out-buf) + (eq var (deserialize (serialize var out-buf)))))
(defun in-out-equal (var) - (serialize var *out-buf*) - (equal var (deserialize (buffer-stream-buffer *out-buf*)))) + (with-buffer-streams (out-buf) + (equal var (deserialize (serialize var out-buf)))))
(defun in-out-equalp (var) - (serialize var *out-buf*) - (equalp var (deserialize (buffer-stream-buffer *out-buf*)))) + (with-buffer-streams (out-buf) + (equalp var (deserialize (serialize var out-buf)))))
(deftest fixnums - (values + (are-not-null (in-out-equal 0) (in-out-equal -1) (in-out-equal 1) @@ -26,7 +26,7 @@ t t t t t)
(deftest fixnum-type-1 - (values + (are-not-null (typep (in-out-value 0) 'fixnum) (typep (in-out-value 1) 'fixnum) (typep (in-out-value -1) 'fixnum) @@ -35,7 +35,7 @@ t t t t t)
(deftest bignums - (values + (are-not-null (in-out-equal 10000000000) (in-out-equal -10000000000) (loop for i from 0 to 2000 @@ -53,7 +53,7 @@ t t t t t t t t)
(deftest floats - (values + (are-not-null (in-out-equal 0.0) (in-out-equal -0.0) (in-out-equal 0.0d0) @@ -86,7 +86,7 @@ t t t t t t t t t t t t t t t t t t t t t t t t t t t t t)
(deftest rationals - (values + (are-not-null (in-out-equal 1/2) (in-out-equal -1/2) (in-out-equal (/ 1 most-positive-fixnum)) @@ -97,20 +97,21 @@ t t t t t t t)
(deftest strings - (values + (are-not-null (in-out-equal "") (in-out-equal "this is a test") (in-out-equal (make-string 400 :initial-element (code-char 254)))) t t t)
(defun in-out-uninterned-equal (var) - (serialize var *out-buf*) - (let ((new (deserialize (buffer-stream-buffer *out-buf*)))) - (and (equal (symbol-name new) (symbol-name var)) - (equal (symbol-package new) (symbol-package var))))) + (with-buffer-streams (out-buf) + (serialize var out-buf) + (let ((new (deserialize (serialize var out-buf)))) + (and (equal (symbol-name new) (symbol-name var)) + (equal (symbol-package new) (symbol-package var))))))
(deftest symbols - (values + (are-not-null (in-out-equal nil) (in-out-equal T) (in-out-equal 'foobarbazquux) @@ -131,16 +132,15 @@ (deftest pathnames ;;; Given how implementation-specific make-pathname is, ;;; i don't know how to put more portable tests here! - (values + (are-not-null (in-out-equal #p"/usr/local/share/common-lisp/elephant")) t)
(deftest conses - (values + (are-not-null (in-out-equal (cons t 100000)) (in-out-equal (list 1 'a "this is a test" 'c 10000 nil 1000 nil)) - (in-out-equal (cons (cons (cons t nil) (cons nil t)) (cons 1 (cons t nil)))) - ) + (in-out-equal (cons (cons (cons t nil) (cons nil t)) (cons 1 (cons t nil))))) t t t)
(deftest hash-tables-1 @@ -150,7 +150,7 @@ (rehash-size (hash-table-rehash-size ht)) (rehash-threshold (hash-table-rehash-threshold ht)) (out (in-out-value ht))) - (values + (are-not-null (eq (hash-table-test out) 'equalp) (= (hash-table-size ht) size) (= (hash-table-rehash-size ht) rehash-size) @@ -169,7 +169,7 @@ (setf (gethash 2 ht) 2.0d0) (setf (gethash 'symbolsymbol ht) "three") (let ((out (in-out-value ht))) - (values + (are-not-null (string= (gethash (cons nil nil) ht) "one") (= (gethash 2 ht) 2.0d0) (string= (gethash 'symbolsymbol ht) "three")))) @@ -179,7 +179,7 @@ (and (subtypep t1 t2) (subtypep t2 t1)))
(deftest arrays-1 - (values + (are-not-null (array-has-fill-pointer-p (in-out-value (make-array 200 :fill-pointer t))) (not (array-has-fill-pointer-p @@ -210,7 +210,7 @@ (loop for i from 0 to 99 do (setf (svref svec i) (expt 2 i))) - (values + (are-not-null (in-out-equalp arr) (in-out-equalp vec) (in-out-equalp svec) @@ -279,7 +279,7 @@ (setf (slot-value f 'slot2) f) (setf (slot-value b 'slot1) h) (setf (slot-value b 'slot2) f) - (values + (are-not-null (deep-equalp c1 c1) (deep-equalp c2 c2) (deep-equalp l1 l1) @@ -290,11 +290,11 @@ t t t t t t t)
(defun in-out-deep-equalp (var) - (serialize var *out-buf*) - (deep-equalp var (deserialize (buffer-stream-buffer *out-buf*)))) + (with-buffer-streams (out-buf) + (deep-equalp var (deserialize (serialize var out-buf)))))
(deftest objects - (values + (are-not-null (in-out-deep-equalp (make-instance 'foo)) (in-out-deep-equalp (make-instance 'bar :slot1 (make-instance 'foo @@ -323,7 +323,7 @@ (setf (slot-value f 'slot2) f) (setf (slot-value b 'slot1) h) (setf (slot-value b 'slot2) f) - (values + (are-not-null (in-out-deep-equalp c1) (in-out-deep-equalp c2) (in-out-deep-equalp l1) @@ -342,12 +342,13 @@ (:metaclass persistent-metaclass))
(deftest persistent - (let ((f1 (make-instance 'pfoo)) - (f2 (make-instance 'pfoo :slot1 "this is a string")) - (b1 (make-instance 'pbar :slot2 "another string")) - (b2 (make-instance 'pbar)) - (h (make-instance 'btree))) - (values + (let* ((*auto-commit* t) + (f1 (make-instance 'pfoo)) + (f2 (make-instance 'pfoo :slot1 "this is a string")) + (b1 (make-instance 'pbar :slot2 "another string")) + (b2 (make-instance 'pbar)) + (h (make-instance 'btree))) + (are-not-null (in-out-eq f1) (in-out-eq f2) (in-out-eq b1) @@ -360,4 +361,3 @@ (progn (setf (get-value f2 h) f2) (eq (get-value f2 h) f2)))) t t t t t t t t) - \ No newline at end of file