From 0f2d02cdd22928b7678dcbc16d825887f5b607c9 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 22 Jul 2015 16:42:05 -0500 Subject: [PATCH] Move part of unstable/logging to racket/logging. ... and improve and extend its interface at the same time. --- .../scribblings/reference/logging.scrbl | 84 +++++++++++++++++-- .../racket-test-core/tests/racket/logger.rktl | 18 ++++ racket/collects/racket/logging.rkt | 60 +++++++++++++ 3 files changed, 156 insertions(+), 6 deletions(-) create mode 100644 racket/collects/racket/logging.rkt diff --git a/pkgs/racket-doc/scribblings/reference/logging.scrbl b/pkgs/racket-doc/scribblings/reference/logging.scrbl index b39849f744..bbd7325e4a 100644 --- a/pkgs/racket-doc/scribblings/reference/logging.scrbl +++ b/pkgs/racket-doc/scribblings/reference/logging.scrbl @@ -84,7 +84,7 @@ otherwise.} @defproc[(make-logger [topic (or/c symbol? #f) #f] [parent (or/c logger? #f) #f] - [propagate-level (or/c 'none 'fatal 'error 'warning 'info 'debug) 'debug] + [propagate-level log-level/c 'debug] [propagate-topic (or/c #f symbol?) #f] ... ...) logger?]{ @@ -134,7 +134,7 @@ created when @racket[define-logger] is evaluated.} @section{Logging Events} @defproc[(log-message [logger logger?] - [level (or/c 'fatal 'error 'warning 'info 'debug)] + [level log-level/c] [topic (or/c symbol? #f) (logger-name logger)] [message string?] [data any/c] @@ -155,7 +155,7 @@ by @racket[": "] before it is sent to receivers. @defproc[(log-level? [logger logger?] - [level (or/c 'fatal 'error 'warning 'info 'debug)] + [level log-level/c] [topic (or/c symbol? #f) #f]) boolean?]{ @@ -180,7 +180,7 @@ that any event information it receives will never become accessible). @defproc[(log-max-level [logger logger?] [topic (or/c symbol? #f) #f]) - (or/c #f 'fatal 'error 'warning 'info 'debug)]{ + (or/c log-level/c #f)]{ Similar to @racket[log-level?], but reports the maximum-detail level of logging for which @racket[log-level?] on @racket[logger] and @racket[topic] returns @racket[#t]. The @@ -191,7 +191,7 @@ currently returns @racket[#f] for all levels. @defproc[(log-all-levels [logger logger?]) - (list/c (or/c #f 'fatal 'error 'warning 'info 'debug) + (list/c (or/c #f log-level/c) (or/c #f symbol?) ... ...)]{ @@ -289,7 +289,7 @@ Returns @racket[#t] if @racket[v] is a @tech{log receiver}, @racket[#f] otherwise.} @defproc[(make-log-receiver [logger logger?] - [level (or/c 'none 'fatal 'error 'warning 'info 'debug)] + [level log-level/c] [topic (or/c #f symbol?) #f] ... ...) log-receiver?]{ @@ -316,3 +316,75 @@ the last given @racket[level]). A @racket[level] for a @racket[#f] provided @racket[topic]. If the same @racket[topic] is provided multiple times, the @racket[level] provided with the last instance in the argument list takes precedence.} + + +@; ---------------------------------------- +@section{Additional Logging Functions} + +@note-lib[racket/logging] +@(require (for-label racket/logging)) +@(define log-eval (make-base-eval)) +@(interaction-eval #:eval log-eval + (require racket/logging)) + +@defproc[(log-level/c [v any/c]) + boolean?]{ +Returns @racket[#t] if @racket[v] is a valid logging level (@racket['none], +@racket['fatal], @racket['error], @racket['warning], @racket['info], or +@racket['debug]), @racket[#f] otherwise. + +@history[#:added "6.2.900.5"]{} +} + +@defproc[(with-intercepted-logging + [interceptor (-> (vector/c + log-level/c + string? + any/c + (or/c symbol? #f)) + any)] + [proc (-> any)] + [log-spec (or/c log-level/c #f)] ...) + any]{ + +Runs @racket[proc], calling @racket[interceptor] on any log event that would +be received by @racket[(make-log-receiver (current-logger) log-spec ...)]. +Returns whatever @racket[proc] returns. + +@defexamples[ +#:eval log-eval +(let ([warning-counter 0]) + (with-intercepted-logging + (lambda (l) + (when (eq? (vector-ref l 0) ; actual level + 'warning) + (set! warning-counter (add1 warning-counter)))) + (lambda () + (log-warning "Warning!") + (log-warning "Warning again!") + (+ 2 2)) + 'warning) + warning-counter)] + +@history[#:added "6.2.900.5"]{}} + +@defproc[(with-logging-to-port + [port output-port?] [proc (-> any)] + [log-spec (or/c 'fatal 'error 'warning 'info 'debug symbol? #f)] ...) + any]{ + +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 log-eval +(let ([my-log (open-output-string)]) + (with-logging-to-port my-log + (lambda () + (log-warning "Warning World!") + (+ 2 2)) + 'warning) + (get-output-string my-log))] + +@history[#:added "6.2.900.5"]{}} diff --git a/pkgs/racket-test-core/tests/racket/logger.rktl b/pkgs/racket-test-core/tests/racket/logger.rktl index 133816e14c..de7049298a 100644 --- a/pkgs/racket-test-core/tests/racket/logger.rktl +++ b/pkgs/racket-test-core/tests/racket/logger.rktl @@ -238,6 +238,24 @@ (test #f sync/timeout 0 r2) (test #f sync/timeout 0 r22)) +; -------------------- +; racket/logging + +(require racket/logging) +(define (test-intercepted-logging) + (define log '()) + (cons (with-intercepted-logging + (lambda (v) (set! log (cons (vector-ref v 1) log))) + (lambda () + (log-warning "1") + (log-warning "2") + (log-warning "3") + (log-info "4") + #t) + 'warning) + log)) +(test '(#t "3" "2" "1") test-intercepted-logging) + ; -------------------- (report-errs) diff --git a/racket/collects/racket/logging.rkt b/racket/collects/racket/logging.rkt new file mode 100644 index 0000000000..bc6121ead5 --- /dev/null +++ b/racket/collects/racket/logging.rkt @@ -0,0 +1,60 @@ +#lang racket/base + +(require racket/contract/base) + +(provide log-level/c) + +(define log-level/c (or/c 'none 'fatal 'error 'warning 'info 'debug)) +(define log-spec? (listof (or/c symbol? #f))) +(define log-event? (vector-immutable/c log-level/c string? any/c (or/c symbol? #f))) + +(provide/contract [with-intercepted-logging + (->* ((-> log-event? any) + (-> any)) + #:rest log-spec? + any)] + [with-logging-to-port + (->* (output-port? (-> any)) + #:rest log-spec? + any)]) + +(define (receiver-thread receiver stop-chan intercept) + (thread + (lambda () + (define (clear-events) + (let ([l (sync/timeout 0 receiver)]) + (when l ; still something to read + (intercept l) ; interceptor gets the whole vector + (clear-events)))) + (let loop () + (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 + (intercept l) + (loop)])))))) + +(define (with-intercepted-logging interceptor proc . log-spec) + (let* ([orig-logger (current-logger)] + ;; 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 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 . log-spec) + (apply with-intercepted-logging + (lambda (l) (displayln (vector-ref l 1) ; actual message + port)) + proc + log-spec))