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+)