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

16 Sep 2004

Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp.net:/tmp/cvs-serv26181/tests
Modified Files:
    mop-tests.lisp 
Log Message:
updates
makunbound
Date: Thu Sep 16 06:26:08 2004
Author: blee
Index: elephant/tests/mop-tests.lisp
diff -u elephant/tests/mop-tests.lisp:1.4 elephant/tests/mop-tests.lisp:1.5

--- elephant/tests/mop-tests.lisp:1.4	Sat Sep  4 11:16:11 2004
+++ elephant/tests/mop-tests.lisp	Thu Sep 16 06:26:08 2004
@@ -84,7 +84,7 @@
   t)
(deftest mixes-right-slots
-    (values
+    (are-not-null
      (typep (find-slot-def 'mix-1 'slot1) 'ele::persistent-slot-definition)
      (typep (find-slot-def 'mix-1 'slot2) 'ele::transient-slot-definition)
      (typep (find-slot-def 'mix-1 'slot3) 'ele::transient-slot-definition)
@@ -115,7 +115,7 @@
   t)
(deftest inherit-right-slots
-    (values
+    (are-not-null
      (typep (find-slot-def 'make-persistent2 'slot1) 
        'ele::persistent-slot-definition)
      (typep (find-slot-def 'make-persistent2 'slot2) 
@@ -138,13 +138,15 @@
   t)
(deftest initform-test
-    (slot-value (make-instance 'p-initform-test) 'slot1)
+    (let ((*auto-commit* t))
+      (slot-value (make-instance 'p-initform-test) 'slot1))
   10)
(deftest initarg-test
-    (values
-     (slot-value (make-instance 'p-initform-test-2) 'slot1)
-     (slot-value (make-instance 'p-initform-test-2 :slot1 20) 'slot1))
+    (let ((*auto-commit* t))
+      (values
+       (slot-value (make-instance 'p-initform-test-2) 'slot1)
+       (slot-value (make-instance 'p-initform-test-2 :slot1 20) 'slot1)))
   10 20)
(deftest no-eval-initform
@@ -160,8 +162,19 @@
     (progn
       (defclass redef () () (:metaclass persistent-metaclass))
       (defclass redef () () (:metaclass persistent-metaclass))
-      (values (subtypep 'redef 'persistent-object)))
+      (is-not-null (subtypep 'redef 'persistent-object)))
   t)
-(with-open-store (*testdb-path*)
-  (do-tests))
+;; i wish i could use slot-makunbound but allegro sux
+(deftest makunbound
+    (let ((p (make-instance 'p-class)))
+      (with-transaction ()
+	(setf (slot1 p) t)
+	#-allegro
+	(slot-makunbound p 'slot1)
+	#+allegro
+	(slot-makunbound-using-class (find-class 'p-class) p 
+				     (find-slot-def 'p-class 'slot1))
+	)
+      (signals-condition (slot1 p)))
+  t)
\ No newline at end of file

    