[bknr-cvs] ksprotte changed trunk/projects/bos/

[BKNR Commits]

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)