Move part of unstable/logging to racket/logging.

... and improve and extend its interface at the same time.

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"]{}}

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)

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))