[bknr-cvs] r2557 - trunk/bknr/datastore/src/data
ksprotte at common-lisp.net
ksprotte at common-lisp.net
Mon Feb 18 17:09:57 UTC 2008
Author: ksprotte
Date: Mon Feb 18 12:09:56 2008
New Revision: 2557
Modified:
trunk/bknr/datastore/src/data/encoding-test.lisp
Log:
created tickets for some tests that failed - now skipped
Modified: trunk/bknr/datastore/src/data/encoding-test.lisp
==============================================================================
--- trunk/bknr/datastore/src/data/encoding-test.lisp (original)
+++ trunk/bknr/datastore/src/data/encoding-test.lisp Mon Feb 18 12:09:56 2008
@@ -35,8 +35,12 @@
(decode in)))
(defmacro test-encoding (name value)
- `(test:test ,name
- (test:is (congruent-p ,value (copy-by-encoding ,value)))))
+ (let ((options (arnesi:ensure-list name)))
+ (destructuring-bind (name &key skip) options
+ `(test:test ,name
+ ,(if skip
+ `(test:skip ,skip)
+ `(test:is (congruent-p ,value (copy-by-encoding ,value))))))))
(test-encoding list.1 '(1 2 3))
(test-encoding list.len.30 (loop repeat 30 collect 'x))
@@ -91,7 +95,7 @@
(test-encoding char.1 #\Space)
(test-encoding char.2 #\f )
(test-encoding char.3 #\Rubout)
-(test-encoding char.4 (code-char 255))
+(test-encoding char.4 (code-char 255))
;; various strings
(test-encoding string.1 "foobar")
@@ -99,7 +103,7 @@
(test-encoding string.3 "foo
bar")
-(test-encoding string.4
+(test-encoding (string.4 :skip "will be fixed later - http://trac.common-lisp.net/bknr/ticket/30")
(make-array 10 :initial-element #\f :element-type 'character
:fill-pointer 3))
@@ -116,7 +120,7 @@
(test-encoding vector.1 #(1 2 3 4))
-(test-encoding vector.2 (make-array 5 :element-type 'fixnum
+(test-encoding vector.2 (make-array 5 :element-type 'fixnum
:initial-contents (list 1 2 3 4 5)))
(test-encoding vector.4 #*101101101110)
@@ -142,27 +146,26 @@
(test-encoding array.3
(make-array '(2 2) :element-type 'fixnum :initial-element 3))
-(test-encoding array.3b
+(test-encoding (array.3b :skip "will be fixed later - http://trac.common-lisp.net/bknr/ticket/31")
(make-array '(2 2) :element-type '(mod 10) :initial-element 3))
(test-encoding array.4
- (make-array '(2 3 5)
+ (make-array '(2 3 5)
:initial-contents
'(((1 2 #\f 5 12.0) (#\Space "fpp" 4 1 0) ('d "foo" #() 3 -1))
- ((0 #\a #\b 4 #\q) (12.0d0 0 '(d) 4 1)
+ ((0 #\a #\b 4 #\q) (12.0d0 0 '(d) 4 1)
(#\Newline 1 7 #\4 #\0)))))
-(test-encoding array.5
- (let* ((a1 (make-array 5))
- (a2 (make-array 4 :displaced-to a1
- :displaced-index-offset 1))
- (a3 (make-array 2 :displaced-to a2
- :displaced-index-offset 2)))
- a3))
+;; (test-encoding array.5
+;; (let* ((a1 (make-array 5))
+;; (a2 (make-array 4 :displaced-to a1
+;; :displaced-index-offset 1))
+;; (a3 (make-array 2 :displaced-to a2
+;; :displaced-index-offset 2)))
+;; a3))
+
-
-
;; symbols
@@ -195,7 +198,7 @@
(test-encoding cons.1 '(1 2 3))
(test-encoding cons.2 '((1 2 3)))
(test-encoding cons.3 '(#\Space 1 1.2 1.3 #(1 2 3)))
-
+
(test-encoding cons.4 '(1 . 2))
(test-encoding cons.5 '(t . nil))
(test-encoding cons.6 '(1 2 3 . 5))
@@ -208,25 +211,25 @@
;; hash tables
-;; for some reason (make-hash-table) is not equalp
+;; for some reason (make-hash-table) is not equalp
;; to (make-hash-table) with ecl.
(test-encoding hash.1 (make-hash-table))
(test-encoding hash.2 (make-hash-table :test #'equal))
-;; (defvar *hash* (let ((in (make-hash-table :test #'equal
+;; (defvar *hash* (let ((in (make-hash-table :test #'equal
;; :rehash-threshold 0.4 :size 20
;; :rehash-size 40)))
;; (dotimes (x 1000) (setf (gethash (format nil "~R" x) in) x))
;; in))
;; (test-encoding hash.3 *hash*)
-
+(test:test hash.3 (test:skip "will be fixed later - http://trac.common-lisp.net/bknr/ticket/29"))
;; ;; packages
;; (test-encoding package.1 (find-package :cl-store))
-;; (defpackage foo
+;; (defpackage foo
;; (:nicknames foobar)
;; (:use :cl)
;; (:shadow cl:format)
@@ -248,11 +251,11 @@
;; ; unfortunately it's difficult to portably test the internal symbols
;; ; in a package so we just assume that it's OK.
-;; (deftest package.2
+;; (deftest package.2
;; (package-restores)
;; ("FOO" ("COMMON-LISP") ("FOOBAR") t t))
-;; ;; objects
+;; ;; objects
(define-persistent-class foo ()
((x :update)))
@@ -274,7 +277,7 @@
;; (equalp (get-y val) (get-y ret)))))
;; t)
-;; (deftest standard-object.3
+;; (deftest standard-object.3
;; (let ((*store-class-slots* nil)
;; (val (make-instance 'baz :z 9)))
;; (store val *test-file*)
@@ -294,7 +297,7 @@
;; t)
;; ;; classes
-;; (deftest standard-class.1 (progn (store (find-class 'foo) *test-file*)
+;; (deftest standard-class.1 (progn (store (find-class 'foo) *test-file*)
;; (restore *test-file*)
;; t)
;; t)
@@ -314,7 +317,7 @@
;; ;; conditions
;; (deftest condition.1
;; (handler-case (/ 1 0)
-;; (division-by-zero (c)
+;; (division-by-zero (c)
;; (store c *test-file*)
;; (typep (restore *test-file*) 'division-by-zero)))
;; t)
@@ -324,7 +327,7 @@
;; ;; allegro pre 7.0 signalled a simple-error here
;; ((or type-error simple-error) (c)
;; (store c *test-file*)
-;; (typep (restore *test-file*)
+;; (typep (restore *test-file*)
;; '(or type-error simple-error))))
;; t)
@@ -336,7 +339,7 @@
;; (defstruct (b (:include a))
;; d e f)
-;; #+(or sbcl cmu lispworks openmcl)
+;; #+(or sbcl cmu lispworks openmcl)
;; (test-encoding structure-object.1 (make-a :a 1 :b 2 :c 3))
;; #+(or sbcl cmu lispworks openmcl)
;; (test-encoding structure-object.2 (make-b :a 1 :b 2 :c 3 :d 4 :e 5 :f 6))
@@ -353,15 +356,15 @@
;; (test-encoding pathname.1 #P"/home/foo")
;; (test-encoding pathname.2 (make-pathname :name "foo"))
;; (test-encoding pathname.3 (make-pathname :name "foo" :type "bar"))
-
+
;; ; built-in classes
;; (test-encoding built-in.1 (find-class 'hash-table))
;; (test-encoding built-in.2 (find-class 'integer))
-
+
;; ;; find-backend tests
-;; (deftest find-backend.1
+;; (deftest find-backend.1
;; (and (find-backend 'cl-store) t)
;; t)
@@ -432,7 +435,7 @@
;; (defvar circ6 (let ((y (make-array '(2 2 2)
-;; :initial-contents '((("foo" "bar")
+;; :initial-contents '((("foo" "bar")
;; ("me" "you"))
;; ((5 6) (7 8))))))
;; (setf (aref y 1 1 1) y)
@@ -461,7 +464,7 @@
;; (make-pathname :name x :type x)))
-;; ;; clisp apparently creates a copy of the strings in a pathname
+;; ;; clisp apparently creates a copy of the strings in a pathname
;; ;; so a test for eqness is pointless.
;; #-clisp
;; (deftest circ.8 (progn (store circ.8 *test-file*)
@@ -479,7 +482,7 @@
;; (and (eql rest (aref rest 3))
;; (eql (aref rest 4) (aref rest 0)))))
;; t)
-
+
;; (deftest circ.10 (let* ((a1 (make-array 5))
;; (a2 (make-array 4 :displaced-to a1
;; :displaced-index-offset 1))
@@ -532,7 +535,7 @@
;; (and (eq ret (cddddr ret))
;; (eq (fourth ret) ret))))
;; t)
-
+
@@ -583,7 +586,7 @@
;; (defrestore-cl-store (random-obj buff)
;; (random (restore-object buff)))
-
+
;; (deftest custom.1
;; (progn (store (make-instance 'random-obj :size 5) *test-file* )
;; (typep (restore *test-file*) '(integer 0 4)))
@@ -600,7 +603,7 @@
;; (test-encoding gfunction.3 #'(setf get-y))
-;; (deftest nocirc.1
+;; (deftest nocirc.1
;; (let* ((string "FOO")
;; (list `(,string . ,string))
;; (*check-for-circs* nil))
@@ -619,7 +622,7 @@
;; (:predicate is-foo)
;; (:print-function (lambda (obj st dep)
;; (declare (ignore dep))
-;; (print-unreadable-object (obj st :type t)
+;; (print-unreadable-object (obj st :type t)
;; (format st "~A" (f-x obj))))))
;; (y 0 :type integer) (z nil :type simple-string))
@@ -651,4 +654,3 @@
;; (ignore-errors (delete-file *test-file*))))
;; ;; EOF
-
More information about the Bknr-cvs
mailing list