Update of /project/elephant/cvsroot/elephant/tests In directory common-lisp.net:/tmp/cvs-serv4131/tests
Modified Files: mop-tests.lisp Log Message: new tests for change class, update class
Date: Tue Sep 21 21:36:35 2004 Author: blee
Index: elephant/tests/mop-tests.lisp diff -u elephant/tests/mop-tests.lisp:1.5 elephant/tests/mop-tests.lisp:1.6 --- elephant/tests/mop-tests.lisp:1.5 Thu Sep 16 06:26:08 2004 +++ elephant/tests/mop-tests.lisp Tue Sep 21 21:36:34 2004 @@ -177,4 +177,45 @@ (find-slot-def 'p-class 'slot1)) ) (signals-condition (slot1 p))) + t) + +(deftest update-class + (progn + (defclass update-class () + ((slot1 :initform 1 :accessor slot1)) + (:metaclass persistent-metaclass)) + (let* ((*auto-commit* t) + (foo (make-instance 'update-class))) + (defclass update-class () + ((slot2 :initform 2 :accessor slot2)) + (:metaclass persistent-metaclass)) + (values + (slot2 foo) + (signals-condition (slot1 foo))))) + 2 t) + +(deftest change-class + (progn + (defclass class-one () + ((slot1 :initform 1 :accessor slot1)) + (:metaclass persistent-metaclass)) + + (defclass class-two () + ((slot1 :initform 0 :accessor slot1) + (slot2 :initform 2 :accessor slot2)) + (:metaclass persistent-metaclass)) + + (let* ((*auto-commit* t) + (foo (make-instance 'class-one))) + (change-class foo (find-class 'class-two)) + (values + (slot1 foo) + (slot2 foo)))) + 1 2) + +(deftest change-class2 + (with-transaction () + (let ((foo (make-instance 'btree))) + (change-class foo (find-class 'indexed-btree)) + (is-not-null (indices foo)))) t)