test (and fix) run-handler-loop

2 files changed, 34 insertions, 11 deletions

diff --git a/spec/xmpp.scm b/spec/xmpp.scm
index cf61e7c..8a945d1 100644
--- a/spec/xmpp.scm
+++ b/spec/xmpp.scm
@@ -137,4 +137,24 @@
 (suite "handle-stanza" (tests))
 (suite "register-temp-stanza-handler-for-id" (tests))
 (suite "register-stanza-handler" (tests))
-(suite "run-handler-loop" (tests))
+
+(suite "run-handler-loop"
+       (tests
+        (test "does not die when a handler throws an exception" e
+              (assert-false
+               (error? (begin
+                         (register-stanza-handler
+                          (lambda _ (throw 'some-error "no reason")))
+                         (call-with-input-string
+                          "<iq from='test' id='123'/><iq from='someone' id='234'/>"
+                          run-handler-loop)))))
+        (test "processes all stanzas in the queue" e
+              (assert-equal 2
+               (let ((count 0))
+                 (register-stanza-handler
+                  (lambda _ (begin (set! count (1+ count))
+                                   (throw 'some-error "no reason"))))
+                 (call-with-input-string
+                  "<iq from='test' id='123'/><iq from='someone' id='234'/>"
+                  run-handler-loop)
+                 count)))))
diff --git a/xmpp.scm b/xmpp.scm
index 546edfc..6a8c242 100644
--- a/xmpp.scm
+++ b/xmpp.scm
@@ -63,21 +63,24 @@ is unregistered."
         ;; return whatever argument was passed to 'halt
         (car args)))))
 
-(define (run-handler-loop port)
-  "Repeatedly check for incoming stanzas.  When a stanza handler exists it is executed in parallel.  A handler may register new handlers."
-  (catch #t
-    (lambda ()
-      (while (not (port-closed? port))
+(define* (run-handler-loop port #:optional (log-port #t))
+  "Repeatedly check for incoming stanzas.  When a stanza handler
+exists it is executed in parallel.  A handler may register new
+handlers."
+  (while (not (or (port-closed? port)
+                  (eof-object? (peek-char port))))
+    (catch #t
+      (lambda _
         (let ((stanza (xml->sxml port #:trim-whitespace? #t)))
-          (format #t "received a stanza: ~s\n" stanza)
+          (format log-port "received a stanza: ~s\n" stanza)
           ;; TODO: handle the stanza in a non-blocking manner!
           (handle-stanza stanza)
           ;; no tight loop, please
           (sleep 1)))
-      (display "port was closed.\n"))
-    (lambda (key . args)
-      (format #t "ERROR: in handler loop: ~a ~a\n" key args)
-      key)))
+      (lambda (key . args)
+        (format log-port "ERROR: in handler loop: ~a ~a\n" key args)
+        key)))
+  (format log-port "port was closed.\n"))
 
 
 (define next-stanza-id!