[elephant-cvs] CVS elephant/tests - elephant-cvs@common-lisp.net - mailman3.common-lisp.net

22 Feb 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)

    