[elephant-cvs] CVS elephant/tests

[rread]

Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp:/tmp/cvs-serv18077

Modified Files:
	testcollections.lisp testmigration.lisp 
Log Message:
This directory used for some initial tests.


--- /project/elephant/cvsroot/elephant/tests/testcollections.lisp	2006/01/25 15:36:32	1.7
+++ /project/elephant/cvsroot/elephant/tests/testcollections.lisp	2006/02/04 20:34:02	1.8
@@ -713,3 +713,20 @@
 ;; 	  (equal (get-value 10 ibt) 4)))
 ;;       )
 ;;   t)
+
+
+
+;; (deftest class-change-deletion
+;;     (progn
+;;       (defclass blob-tbc ()
+;; 	((slot1 :accessor slot1 :initarg :slot1)
+;; 	 (slot2 :accessor slot2 :initarg :slot2)))
+;;       (add-to-root "blob" (make-instance 'blob-tbc))
+;;       (defclass blob-tbc ()
+;; 	((slot1 :accessor slot1 :initarg :slot1)
+;; 	 (slot3 :accessor slot3 :initarg :slot3)))
+;;       (remove-from-root "blob")
+;;       (get-from-root "blob")
+;;       )
+;;   nil nil)
+
--- /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2006/01/24 18:25:01	1.3
+++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2006/02/04 20:34:02	1.4
@@ -156,46 +156,38 @@
 	(progn
 	  (format t "*test-path-secondary*  and *test-path-primary* not both set, skipping this test.")
 	  t)
-    (finishes
-      (let ((old-store *store-controller*)
-	    (*prev-commit* *auto-commit*)
-	    (*auto-commit* t))
-	(unwind-protect 
-	     (let ((osc (if (subtypep (type-of *store-controller*) 'sql-store-controller)
-			   (open-store *test-path-primary*)
-			   (open-store *test-path-secondary*)
-			   )))
-;; really need to test the an error is thrown when attempting to migrate
-;; non-persistent object!
-	     (let* ((f1 (make-instance 'pfoo  :sc *store-controller*))
-		    (f2 (make-instance 'pfoo :slot1 "this is a string"  :sc *store-controller*))
-		    (b1 (make-instance 'pbar :slot2 "another string"  :sc *store-controller*))
-		    )		 
-	       (let ((fm1 
-		      (ele::migraten-pobj 
-		       osc f1
-		       #'(lambda (dst src)
-			   (if (slot-boundp src 'slot1)
-			   (setf (slot1 dst) (slot1 src))))))
-		     (fm2 
-		      (ele::migraten-pobj 
-		       osc f2
-		       #'(lambda (dst src)
-			   (if (slot-boundp src 'slot1)
-			   (setf (slot1 dst) (slot1 src))))))
-		     (bm1 (ele::migraten-pobj 
-			   osc b1
-			   #'(lambda (dst src)
-			   (if (slot-boundp src 'slot2)
-			       (setf (slot2 dst) (slot2 src))))))
-			  )
-		     (and 
-		      (and (not (slot-boundp fm1 'slot1))
-			   (not (slot-boundp f1 'slot1)))
-		      (equal (slot1 fm2) (slot1 f2))
-		      (equal (slot2 bm1) (slot2 b1))))))
-	(progn
-	  (setq *store-controller* old-store)
+	(let ((*prev-commit* *auto-commit*))
+	(prog2 
+	    (setq *auto-commit* t)
+	       (let (
+		     (sc1 (open-store *test-path-primary*))
+		     (sc2 (open-store *test-path-secondary*)))
+	      (let* ((f1 (make-instance 'pfoo  :sc sc1))
+		     (f2 (make-instance 'pfoo :slot1 "this is a string"  :sc sc1))
+		     (b1 (make-instance 'pbar :slot2 "another string"  :sc sc1))
+		     )		 
+		(let ((fm1 
+		       (ele::migraten-pobj 
+			sc2 f1
+			#'(lambda (dst src)
+			    (if (slot-boundp src 'slot1)
+				(setf (slot1 dst) (slot1 src))))))
+		      (fm2 
+		       (ele::migraten-pobj 
+			sc2 f2
+			#'(lambda (dst src)
+			    (if (slot-boundp src 'slot1)
+				(setf (slot1 dst) (slot1 src))))))
+		      (bm1 (ele::migraten-pobj 
+			    sc2 b1
+			    #'(lambda (dst src)
+				(if (slot-boundp src 'slot2)
+				    (setf (slot2 dst) (slot2 src))))))
+		      )
+		  (and 
+		   (and (not (slot-boundp fm1 'slot1))
+			(not (slot-boundp f1 'slot1)))
+		   (equal (slot1 fm2) (slot1 f2))
+		   (equal (slot2 bm1) (slot2 b1))))))
 	  (setq *auto-commit* *prev-commit*))))
-      ))
-  t)
+	  t)