[elephant-cvs] CVS elephant/tests
ieslick
ieslick at common-lisp.net
Wed Feb 22 04:40:57 UTC 2006
Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp:/tmp/cvs-serv15680/tests
Modified Files:
testindexing.lisp
Log Message:
Added final indexing test (redefine class) green under ACL (and shouldn't have
a problem under SBCL). A little tweak here and there, updated the TODO list.
--- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/02/21 19:40:08 1.6
+++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/02/22 04:40:57 1.7
@@ -217,14 +217,49 @@
1 t 2 40 nil nil nil 1 1)
(deftest indexing-redef-class
- nil
- nil)
-
-(deftest indexing-explicit-changes
- nil
+ (progn
+ (when (find-class 'idx-eight nil)
+ (disable-class-indexing 'idx-eight :errorp nil)
+ (setf (find-class 'idx-six nil) nil))
+
+ (defclass idx-eight ()
+ ((slot1 :accessor slot1 :initarg :slot1 :index t)
+ (slot2 :accessor slot2 :initarg :slot2)
+ (slot3 :accessor slot3 :initarg :slot3 :transient t)
+ (slot4 :accessor slot4 :initarg :slot4 :index t)
+ (slot5 :accessor slot5 :initarg :slot5)))
+
+ (let ((o1 nil)
+ (o2 nil))
+ (with-transaction ()
+ (setf o1 (make-instance 'idx-eight :slot1 1 :slot2 2 :slot3 3 :slot4 4 :slot5 5))
+ (setf o2 (make-instance 'idx-eight :slot1 10 :slot2 20 :slot3 30 :slot4 40 :slot5 50)))
+
+ (defclass idx-eight ()
+ ((slot1 :accessor slot1 :initarg :slot1 :initform 11)
+ (slot2 :accessor slot2 :initarg :slot2 :initform 12 :index t)
+ (slot3 :accessor slot3 :initarg :slot3 :initform 13)
+ (slot6 :accessor slot6 :initarg :slot6 :initform 14 :index t)
+ (slot7 :accessor slot7 :initarg :slot7)))
+
+ (values
+ (and (eq (slot1 o1) 1)
+ (signals-error (get-instances-by-value 'idx-eight 'slot1 1)))
+ (and (eq (slot2 o1) 2)
+ (eq (length (get-instances-by-value 'idx-eight 'slot2 2)) 1))
+ (eq (slot3 o1) 13) ;; transient values not preserved (would be inconsistent)
+ (and (not (slot-exists-p o1 'slot4))
+ (not (slot-exists-p o1 'slot5))
+ (signals-error (get-instances-by-value 'idx-eight 'slot4)))
+ (and (eq (slot6 o1) 14)
+ (eq (length (get-instances-by-value 'idx-eight 'slot6 14)) 2))
+ (and (not (slot-boundp o1 'slot7))))))
+ t t t t t t)
+
+
nil)
-;; create 10k objects, write each object's slots
+;; create 500 objects, write each object's slots
(defclass stress-normal ()
((stress1 :accessor stress1 :initarg :stress1 :initform nil :index nil)
More information about the Elephant-cvs
mailing list