From eafd5771b50715d2982fe435b2bc82d0dbbd0813 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Thu, 16 May 2019 12:39:16 +0100 Subject: [PATCH] Drain ws-ch in an additional, previously-overlooked case --- imperative/drivers/web.rkt | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/imperative/drivers/web.rkt b/imperative/drivers/web.rkt index 17cb9b5..19e5b6b 100644 --- a/imperative/drivers/web.rkt +++ b/imperative/drivers/web.rkt @@ -275,7 +275,8 @@ (list))) (output-response/method conn resp - (request-method req))))) + (request-method req)) + (drain-ws-ch! ws-ch)))) ((make-general-websockets-dispatcher (websocket-connection-main id ws-ch) (lambda _args (values reply-headers (void)))) @@ -317,9 +318,11 @@ (loop)])))) (ws-close! wsc)) (when (not quit-seen?) - (let loop () - (when (not (equal? (channel-get ws-ch) 'quit)) - (loop))))) + (drain-ws-ch! ws-ch))) + +(define (drain-ws-ch! ws-ch) + (when (not (equal? (channel-get ws-ch) 'quit)) + (drain-ws-ch! ws-ch))) ;; D-: uck barf ;; TODO: something to fix this :-/