From 5a24b57a9516fb781363dc8d7f4b59c16ae238b9 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Fri, 7 Sep 2012 15:46:51 -0400 Subject: [PATCH] Fix unstable/logging to work with the new logging system. --- collects/tests/unstable/logging.rkt | 2 +- collects/unstable/logging.rkt | 44 +++++++++------------ collects/unstable/scribblings/logging.scrbl | 34 ++++++++-------- 3 files changed, 38 insertions(+), 42 deletions(-) diff --git a/collects/tests/unstable/logging.rkt b/collects/tests/unstable/logging.rkt index 47d3d1205f..b715be9fed 100644 --- a/collects/tests/unstable/logging.rkt +++ b/collects/tests/unstable/logging.rkt @@ -5,7 +5,7 @@ (run-tests (test-suite "logging.rkt" (test-case "start/stop-recording" - (let ([l (start-recording #:level 'warning)]) + (let ([l (start-recording 'warning)]) (log-warning "1") (log-warning "2") (log-warning "3") diff --git a/collects/unstable/logging.rkt b/collects/unstable/logging.rkt index 49aa414662..b1fbbf525d 100644 --- a/collects/unstable/logging.rkt +++ b/collects/unstable/logging.rkt @@ -3,6 +3,7 @@ (require racket/contract/base) (define level/c (or/c 'fatal 'error 'warning 'info 'debug)) +(define log-spec/c (listof (or/c symbol? #f))) (define log-message/c (vector/c level/c string? any/c)) ;; helper used below @@ -33,8 +34,8 @@ [done? #:mutable])) ;; [level] -> listener -(define (start-recording #:level [level 'debug]) - (let* ([receiver (make-log-receiver (current-logger) level)] +(define (start-recording . log-spec) + (let* ([receiver (apply make-log-receiver (current-logger) log-spec)] [stop-chan (make-channel)] [cur-listener (listener stop-chan #f '() #f)] [t (receiver-thread @@ -56,45 +57,38 @@ (reverse (listener-rev-messages cur-listener))) (provide/contract - [start-recording (->* () (#:level level/c) listener?)] + [start-recording (->* () #:rest log-spec/c listener?)] [stop-recording (-> listener? (listof log-message/c))]) -(define (with-intercepted-logging interceptor proc #:level [level 'debug]) +(define (with-intercepted-logging interceptor proc . log-spec) (let* ([orig-logger (current-logger)] - ;; the new logger is unrelated to the original, to avoid getting - ;; messages sent to it that didn't originate from proc - [logger (make-logger)] - [receiver (make-log-receiver logger level)] + ;; We use a local logger to avoid getting messages that didn't + ;; originate from proc. Since it's a child of the original logger, + ;; the rest of the program still sees the log entries. + [logger (make-logger #f orig-logger)] + [receiver (apply make-log-receiver logger log-spec)] [stop-chan (make-channel)] - [t (receiver-thread - receiver stop-chan - (lambda (l) - ;; we want to send l to the original logger, so that - ;; the rest of the system can see it too. - (log-message orig-logger - (vector-ref l 0) ; level - (vector-ref l 1) ; message - (vector-ref l 2)) ; data - (interceptor l)))]) + [t (receiver-thread receiver stop-chan interceptor)]) (begin0 (parameterize ([current-logger logger]) (proc)) (channel-put stop-chan 'stop) ; stop the receiver thread (thread-wait t)))) -(define (with-logging-to-port port proc #:level [level 'debug]) - (with-intercepted-logging - (lambda (l) (displayln (vector-ref l 1) ; actual message - port)) - proc #:level level)) +(define (with-logging-to-port port proc . log-spec) + (apply with-intercepted-logging + (lambda (l) (displayln (vector-ref l 1) ; actual message + port)) + proc + log-spec)) (provide/contract [with-intercepted-logging (->* ((-> log-message/c any) (-> any)) - (#:level level/c) + #:rest log-spec/c any)] [with-logging-to-port (->* (output-port? (-> any)) - (#:level level/c) + #:rest log-spec/c any)]) diff --git a/collects/unstable/scribblings/logging.scrbl b/collects/unstable/scribblings/logging.scrbl index 358d99a315..17f3070ed2 100644 --- a/collects/unstable/scribblings/logging.scrbl +++ b/collects/unstable/scribblings/logging.scrbl @@ -13,11 +13,12 @@ This module provides tools for logging. @defproc[(with-logging-to-port [port output-port?] [proc (-> any)] - [#:level level (or/c 'fatal 'error 'warning 'info 'debug) 'debug]) + [log-spec (or/c 'fatal 'error 'warning 'info 'debug symbol? #f)] ...) any]{ -Runs @racket[proc], outputting any logging of level @racket[level] or higher to -@racket[port]. Returns whatever @racket[proc] returns. +Runs @racket[proc], outputting any logging that would be received by +@racket[(make-log-receiver (current-logger) log-spec ...)] to @racket[port]. +Returns whatever @racket[proc] returns. @defexamples[ #:eval the-eval @@ -26,22 +27,23 @@ Runs @racket[proc], outputting any logging of level @racket[level] or higher to (lambda () (log-warning "Warning World!") (+ 2 2)) - #:level 'warning) + 'warning) (get-output-string my-log))]} @defproc[(with-intercepted-logging [interceptor (-> (vector/c - (or/c 'fatal 'error 'warning 'info 'debug) - string? + (or/c 'fatal 'error 'warning 'info 'debug) + string? any/c) any)] [proc (-> any)] - [#:level level (or/c 'fatal 'error 'warning 'info 'debug) 'debug]) + [log-spec (or/c 'fatal 'error 'warning 'info 'debug symbol? #f)] ...) any]{ -Runs @racket[proc], calling @racket[interceptor] on any log message of level -@racket[level] or higher. @racket[interceptor] receives the entire log vectors +Runs @racket[proc], calling @racket[interceptor] on any log message that would +be received by @racket[(make-log-receiver (current-logger) log-spec ...)]. +@racket[interceptor] receives the entire log vectors (see @secref["receiving-logged-events" #:doc '(lib "scribblings/reference/reference.scrbl")]) as arguments. Returns whatever @racket[proc] returns. @@ -57,7 +59,7 @@ as arguments. Returns whatever @racket[proc] returns. (log-warning "Warning!") (log-warning "Warning again!") (+ 2 2)) - #:level 'warning) + 'warning) warning-counter)]} @@ -65,21 +67,21 @@ A lower-level interface to logging is also available. @deftogether[[ @defproc[(start-recording - [#:level level (or/c 'fatal 'error 'warning 'info 'debug) 'debug]) + [log-spec (or/c 'fatal 'error 'warning 'info 'debug symbol? #f)] ...) listener?] @defproc[(stop-recording [listener listener?]) (listof (vector/c (or/c 'fatal 'error 'warning 'info 'debug) string? any/c))]]]{ -@racket[start-recording] starts recording log messages of the desired level or -higher. Messages will be recorded until stopped by passing the returned -listener object to @racket[stop-recording]. @racket[stop-recording] will then -return a list of the log messages that have been reported. +@racket[start-recording] starts recording log messages matching the given +@racket[log-spec]. Messages will be recorded until stopped by passing the +returned listener object to @racket[stop-recording]. @racket[stop-recording] +will then return a list of the log messages that have been reported. @defexamples[ #:eval the-eval -(define l (start-recording #:level 'warning)) +(define l (start-recording 'warning)) (log-warning "1") (log-warning "2") (stop-recording l)