[elephant-cvs] CVS update: elephant/tests/testserializer.lisp
blee at common-lisp.net
blee at common-lisp.net
Thu Sep 16 04:27:20 UTC 2004
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
More information about the Elephant-cvs
mailing list