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

[BKNR Commits]

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

dont start contract-tree-image-update-daemon when testing

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

Modified: trunk/projects/bos/test/fixtures.lisp
===================================================================
--- trunk/projects/bos/test/fixtures.lisp	2008-07-16 12:28:41 UTC (rev 3460)
+++ trunk/projects/bos/test/fixtures.lisp	2008-07-16 12:49:49 UTC (rev 3461)
@@ -5,8 +5,9 @@
   (when snapshot
     (format t "~&;; ++ taking snapshot~%")
     (snapshot))
-  (bos.m2::reinit :directory (bknr.datastore::store-directory *store*)
-		  :website-url bos.m2::*website-url*)
+  (let ((bos.web::*start-contract-tree-image-update-daemon* nil))
+    (bos.m2::reinit :directory (bknr.datastore::store-directory *store*)
+                    :website-url bos.m2::*website-url*))
   (format t "~&;; ++ reopen-store done~%"))
 
 (defmacro reopen-store ((&key snapshot) &rest store-object-vars)
@@ -50,7 +51,7 @@
   (let ((store-path (parse-namestring
                      (format nil "/tmp/test-store-~D.tmp/" (get-universal-time)))))
     (unwind-protect
-         (progn
+         (let ((bos.web::*start-contract-tree-image-update-daemon* nil))
            (bos.m2::reinit :delete t
                            :directory store-path
                            :website-url bos.m2::*website-url*)

Modified: trunk/projects/bos/web/contract-tree.lisp
===================================================================
--- trunk/projects/bos/web/contract-tree.lisp	2008-07-16 12:28:41 UTC (rev 3460)
+++ trunk/projects/bos/web/contract-tree.lisp	2008-07-16 12:49:49 UTC (rev 3461)
@@ -306,6 +306,7 @@
 ;; contract-tree image update daemon
 (defvar *contract-tree-image-update-daemon* nil)
 (defvar *contract-tree-image-update-daemon-halt*)
+(defvar *start-contract-tree-image-update-daemon* t)
 
 (defun contract-tree-image-update-daemon-loop ()
   (loop (when *contract-tree-image-update-daemon-halt* (return))
@@ -322,10 +323,18 @@
     (bt:make-thread #'contract-tree-image-update-daemon-loop
                     :name "contract-tree-image-update-daemon")))
 
-(defun stop-contract-tree-image-update-daemon ()
+(defun stop-contract-tree-image-update-daemon (&key wait)
   (when (contract-tree-image-update-daemon-running-p)
     (setq *contract-tree-image-update-daemon-halt* t)
-    (warn "contract-tree-image-update-daemon will stop soon")))
+    (warn "contract-tree-image-update-daemon will stop soon")
+    (when wait
+      (loop repeat 20
+         do (progn (sleep 1)
+                   (when (not (contract-tree-image-update-daemon-running-p))
+                     (return))))
+      (if (contract-tree-image-update-daemon-running-p)
+          (error "Failed to stop contract-tree-image-update-daemon")
+          (warn "contract-tree-image-update-daemon stopped")))))
 
 ;;; make-contract-tree-from-m2
 (defun make-contract-tree-from-m2 ()  
@@ -338,7 +347,8 @@
     (when (contract-published-p contract)
       (insert-contract *contract-tree* contract)))
   (format t "~&rendering contract-tree images if needed...") (force-output)
-  (start-contract-tree-image-update-daemon)
+  (when *start-contract-tree-image-update-daemon*
+    (start-contract-tree-image-update-daemon))
   (format t "done.~%") (force-output)  
   (geometry:register-rect-subscriber geometry:*rect-publisher* *contract-tree*
                                      (list 0 0 +width+ +width+)