Getting started on unit tests

[eow] / web.lisp

diff --git a/web.lisp b/web.lisp
index 96fcb29d51da10120c0dd1e6a8004d6c03c5356d..c7ead803bf9f3a808610b80a10d0a286ed2447db 100644 (file)
--- a/web.lisp
+++ b/web.lisp
@@ -37,6 +37,10 @@
     :accessor update-queue
     :initform (locked-queue:create)
     :documentation "Updates to be sent to the browser")
+   (update-thread
+    :accessor update-thread
+    :initform nil
+    :documentation "COMET thread waiting for updates of non-NIL")
    (connection
    :accessor connection
    :documentation "Connection to the empire game server")))
@@ -64,7 +68,16 @@
 (defun update ()
   "Send stream of updates to client"
   (with-session
-    (locked-queue:dequeue (update-queue *empire-session*))))
+      (when (update-thread *empire-session*)
+       (empire-log:info "~a: Killing update thread ~a." *empire-session* (update-thread *empire-session*))
+       (sb-thread:terminate-thread (update-thread *empire-session*)))
+    (setf (update-thread *empire-session*) sb-thread:*current-thread*)
+    (let ((next-updates (locked-queue:dequeue-all (update-queue *empire-session*))))
+      ; There's a race here. The next update thread might kill this one before
+      ; sending the reply.
+      (setf (update-thread *empire-session*) nil)
+      (nconc next-updates (list (parenscript:ps* '(next))))
+      (apply #'concatenate 'string next-updates))))
 
 (defmethod send ((s session) string)
   "Push a javascript update fragment to the client."