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

fixed a problem with sat-layer destroy-object, where snapshot would fail afterwards

_U trunk/projects/bos/ U trunk/projects/bos/test/bos.test.asd A trunk/projects/bos/test/web/sat-tree.lisp U trunk/projects/bos/web/sat-tree.lisp

Property changes on: trunk/projects/bos ___________________________________________________________________ Name: svn:ignore - datastore web.rc m2.rc TAGS bos.core screenrc

+ datastore web.rc m2.rc TAGS bos.core screenrc hunchentoot-access.log hunchentoot-error.log

Modified: trunk/projects/bos/test/bos.test.asd =================================================================== --- trunk/projects/bos/test/bos.test.asd 2008-07-10 09:32:53 UTC (rev 3420) +++ trunk/projects/bos/test/bos.test.asd 2008-07-10 13:37:33 UTC (rev 3421) @@ -14,4 +14,5 @@ :depends-on ("suites" "fixtures") :components ((:file "drakma-requests") - (:file "quad-tree"))))) + (:file "quad-tree") + (:file "sat-tree")))))

Added: trunk/projects/bos/test/web/sat-tree.lisp =================================================================== --- trunk/projects/bos/test/web/sat-tree.lisp (rev 0) +++ trunk/projects/bos/test/web/sat-tree.lisp 2008-07-10 13:37:33 UTC (rev 3421) @@ -0,0 +1,19 @@ +(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) + (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))))) +

Modified: trunk/projects/bos/web/sat-tree.lisp =================================================================== --- trunk/projects/bos/web/sat-tree.lisp 2008-07-10 09:32:53 UTC (rev 3420) +++ trunk/projects/bos/web/sat-tree.lisp 2008-07-10 13:37:33 UTC (rev 3421) @@ -18,8 +18,10 @@ (format stream "name: ~s" (name obj))))

(defmethod destroy-object :before ((obj sat-layer)) - (dolist (top-level-node (sat-layer-top-level-nodes obj)) - (delete-node-extension top-level-node))) + ;; (dolist (top-level-node (sat-layer-top-level-nodes obj)) + ;; (delete-node-extension top-level-node)) + (dolist (sat-image (class-instances 'sat-image)) + (delete-object sat-image)))

(defun sat-layer-top-level-nodes (sat-layer) (check-type sat-layer sat-layer)