From 191c3b46018fef0756278cd2b9fe91051e7fcda2 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Tue, 31 May 2011 18:48:31 -0400 Subject: [PATCH] Revise with-logging-to-port to avoid the extra dummy log entry. original commit: 47f48c08ad4aaa5d33b8dd9ac91f7228e7cfc2b5 --- collects/tests/typed-scheme/optimizer/run.rkt | 34 +++++++++++++------ 1 file changed, 24 insertions(+), 10 deletions(-) diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt index 4738258e..fefc4099 100644 --- a/collects/tests/typed-scheme/optimizer/run.rkt +++ b/collects/tests/typed-scheme/optimizer/run.rkt @@ -6,18 +6,32 @@ test-opt test-missed-optimization) (define (with-logging-to-port port level proc) - (let* ([logger (current-logger)] - [receiver (make-log-receiver logger level)] - [stop-key (gensym)] + (let* ([logger (make-logger #f (current-logger))] + [receiver (make-log-receiver logger level)] + [stop-chan (make-channel)] [t (thread (lambda () + (define (output-event l) + (displayln (vector-ref l 1) ; actual message + port)) + (define (clear-events) + (let ([l (sync/timeout 0 receiver)]) + (when l ; still something to read + (output-event l) + (clear-events)))) (let loop () - (let ([l (sync receiver)]) - (unless (eq? (vector-ref l 2) stop-key) - (displayln (vector-ref l 1) ; actual message - port) - (loop))))))]) - (begin0 (proc) - (log-message logger level "" stop-key) ; stop the receiver thread + (let ([l (sync receiver stop-chan)]) + (cond [(eq? l 'stop) + ;; we received all the events we were supposed + ;; to get, read them all (w/o waiting), then + ;; stop + (clear-events)] + [else ; keep going + (output-event l) + (loop)])))))]) + (begin0 + (parameterize ([current-logger logger]) + (proc)) + (channel-put stop-chan 'stop) ; stop the receiver thread (thread-wait t)))) ;; TODO put in unstable somewhere