Revision: 3422 Author: ksprotte URL: http://bknr.net/trac/changeset/3422

quick fix to test delete-sat-layer-and-snapshot

U trunk/projects/bos/test/fixtures.lisp U trunk/projects/bos/test/web/sat-tree.lisp

Modified: trunk/projects/bos/test/fixtures.lisp =================================================================== --- trunk/projects/bos/test/fixtures.lisp 2008-07-10 13:37:33 UTC (rev 3421) +++ trunk/projects/bos/test/fixtures.lisp 2008-07-10 14:31:04 UTC (rev 3422) @@ -18,24 +18,28 @@ `(let (,@(iter (for id-var in id-vars) (for store-object-var in store-object-vars) - (collect `(,id-var (store-object-id ,store-object-var))))) + (collect `(,id-var (when (and ,store-object-var + (not (object-destroyed-p ,store-object-var))) + (store-object-id ,store-object-var)))))) (%reopen-store :snapshot ,snapshot) (setf ,@(iter (for id-var in id-vars) (for store-object-var in store-object-vars) (collect store-object-var) - (collect `(find-store-object ,id-var))))))) + (collect `(when ,id-var (find-store-object ,id-var))))))))

(defmacro %with-store-reopenings ((&key snapshot bypass) (&rest store-object-vars) &body body) - `(progn - ,@(if bypass - body - (iter - (for form in body) - (unless (first-time-p) - (collect `(reopen-store (:snapshot ,snapshot) ,@store-object-vars))) - (collect form))))) + `(let ((snapshot ,snapshot) + (bypass ,bypass)) + (if bypass + (progn ,@body) + (progn + ,@(iter + (for form in body) + (unless (first-time-p) + (collect `(reopen-store (:snapshot ,snapshot) ,@store-object-vars))) + (collect form))))))

(defmacro with-store-reopenings ((&rest store-object-vars) &body body) `(%with-store-reopenings (:snapshot snapshot :bypass bypass)

Modified: trunk/projects/bos/test/web/sat-tree.lisp =================================================================== --- trunk/projects/bos/test/web/sat-tree.lisp 2008-07-10 13:37:33 UTC (rev 3421) +++ trunk/projects/bos/test/web/sat-tree.lisp 2008-07-10 14:31:04 UTC (rev 3422) @@ -1,19 +1,10 @@ (in-package :bos.test) (in-suite :bos.test.web)

-(test delete-sat-layer-and-snapshot - (with-fixture initial-bos-store () - (let ((geo-box (bos.web::rectangle-geo-box (bos.web::make-rectangle2 '(10 10 100 100))))) - (cl-gd:with-image (image 1000 1000) +(store-test delete-sat-layer-and-snapshot + (let ((geo-box (bos.web::rectangle-geo-box (bos.web::make-rectangle2 '(10 10 100 100))))) + (cl-gd:with-image (image 1000 1000) + (with-store-reopenings () (bos.web::make-sat-layer image geo-box :test 0) (delete-object (first (class-instances 'bos.web::sat-layer))) - (finishes (snapshot)))))) - -;; (store-test delete-sat-layer-and-snapshot.2 -;; (let ((geo-box (bos.web::rectangle-geo-box (bos.web::make-rectangle2 '(10 10 100 100))))) -;; (cl-gd:with-image (image 1000 1000) -;; (with-store-reopenings () -;; (bos.web::make-sat-layer image geo-box :test 0) -;; (delete-object (first (class-instances 'bos.web::sat-layer))) -;; (pass))))) - + (pass)))))