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

21 Apr 2007


      Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv4643
Added Files:
    testconditions.lisp 
Log Message:
New test file for conditions as we add them
--- /project/elephant/cvsroot/elephant/tests/testconditions.lisp	2007/04/21 17:26:37	NONE
+++ /project/elephant/cvsroot/elephant/tests/testconditions.lisp	2007/04/21 17:26:37	1.1
;;; testconditions.lisp
;;;
;;; part of
;;;
;;; Elephant: an object-oriented database for Common Lisp
;;;
;;; Copyright (c) 2007 by Ian Eslick
;;; <ieslick common-lisp net>
;;;
;;; Elephant users are granted the rights to distribute and use this software
;;; as governed by the terms of the Lisp Lesser GNU Public License
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
(in-package :ele-tests)
(deftest cross-store-reference-condition
  (if (or (not (boundp '*test-spec-secondary*))
      (null *test-spec-secondary*))
      (progn 
    (format t "~%Second store spec missing: ignoring")
    t)
      (let (*store-controller*
        (sc1 (open-store *test-spec-primary* :recover t :deadlock-detect nil))
        (sc2 (open-store *test-spec-secondary* :recover t :deadlock-detect nil)))
    (unwind-protect
         (progn
           (let ((inst1 (make-instance 'pfoo :slot1 100 :sc sc1))
    	     (inst2 (make-instance 'pfoo :slot1 200 :sc sc2)))
    	 (values 
    	  (is-not-null (add-to-root 'inst1 inst1 :sc sc1))
    	  (is-not-null (add-to-root 'inst2 inst2 :sc sc2))
    	  (signals-condition (add-to-root 'inst1 inst1 :sc2))
    	  (signals-condition (add-to-root 'inst2 inst2 :sc1)))))
      (close-store sc1)
      (close-store sc2))))
  t t t t)