From ecadde3a65fe76e7c9c0ad3888d102c62b6ad50b Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 10 Oct 2016 13:13:16 -0500
Subject: [PATCH] Add #:logger keyword argument to with-intercepted-logging.

Closes #1486.
---
 .../scribblings/reference/logging.scrbl       | 19 +++++++++++++------
 .../racket-test-core/tests/racket/logger.rktl | 18 ++++++++++++++++++
 racket/collects/racket/logging.rkt            | 13 +++++++++----
 3 files changed, 40 insertions(+), 10 deletions(-)

diff --git a/pkgs/racket-doc/scribblings/reference/logging.scrbl b/pkgs/racket-doc/scribblings/reference/logging.scrbl
index dc87b1fc30..339cec0d0a 100644
--- a/pkgs/racket-doc/scribblings/reference/logging.scrbl
+++ b/pkgs/racket-doc/scribblings/reference/logging.scrbl
@@ -351,13 +351,17 @@ Returns @racket[#t] if @racket[v] is a valid logging level (@racket['none],
                               (or/c symbol? #f))
                              any)]
            [proc (-> any)]
+           [#:logger logger logger? #f]
            [level log-level/c]
            [topic (or/c #f symbol?) #f]
            ... ...)
          any]{
 
-Runs @racket[proc], calling @racket[interceptor] on any log event that would
-be received by @racket[(make-log-receiver (current-logger) level topic ... ...)].
+Runs @racket[proc], calling @racket[interceptor] on any log event that the
+execution of @racket[proc] emits to @racket[current-logger] at the specified
+levels and topics.
+If @racket[#:logger] is specified, intercepts events sent to that logger,
+otherwise uses a new child logger of the current logger.
 Returns whatever @racket[proc] returns.
 
 @examples[
@@ -375,17 +379,20 @@ Returns whatever @racket[proc] returns.
     'warning)
   warning-counter)]
 
-@history[#:added "6.3"]{}}
+@history[#:added "6.3" #:changed "6.7.0.1" @elem{Added @racket[#:logger] argument.}]{}}
 
 @defproc[(with-logging-to-port
            [port output-port?] [proc (-> any)]
+           [#:logger logger logger? #f]
            [level log-level/c]
            [topic (or/c #f symbol?) #f]
            ... ...)
          any]{
 
-Runs @racket[proc], outputting any logging that would be received by
-@racket[(make-log-receiver (current-logger) level topic ... ...)] to @racket[port].
+Runs @racket[proc], outputting any logging that the execution of @racket[proc]
+emits to @racket[current-logger] at the specified levels and topics.
+If @racket[#:logger] is specified, intercepts events sent to that logger,
+otherwise uses a new child logger of the current logger.
 Returns whatever @racket[proc] returns.
 
 @examples[
@@ -398,4 +405,4 @@ Returns whatever @racket[proc] returns.
     'warning)
   (get-output-string my-log))]
 
-@history[#:added "6.3"]{}}
+@history[#:added "6.3" #:changed "6.7.0.1" @elem{Added @racket[#:logger] argument.}]{}}
diff --git a/pkgs/racket-test-core/tests/racket/logger.rktl b/pkgs/racket-test-core/tests/racket/logger.rktl
index de7049298a..2a13c704fe 100644
--- a/pkgs/racket-test-core/tests/racket/logger.rktl
+++ b/pkgs/racket-test-core/tests/racket/logger.rktl
@@ -256,6 +256,24 @@
         log))
 (test '(#t "3" "2" "1") test-intercepted-logging)
 
+;; From issue #1486
+(define (test-intercepted-logging2)
+  (let ([warning-counter 0]
+        [l (current-logger)])
+    (with-intercepted-logging
+        #:logger l
+        (lambda (l)
+          (when (eq? (vector-ref l 0)
+                     'warning)
+            (set! warning-counter (add1 warning-counter))))
+      (lambda ()
+        (log-message l 'warning "Warning!" (current-continuation-marks))
+        (log-message l 'warning "Warning again!" (current-continuation-marks))
+        (+ 2 2))
+      'warning)
+    warning-counter))
+(test 2 test-intercepted-logging2)
+
 ; --------------------
 
 (report-errs)
diff --git a/racket/collects/racket/logging.rkt b/racket/collects/racket/logging.rkt
index bc6121ead5..4793760b2c 100644
--- a/racket/collects/racket/logging.rkt
+++ b/racket/collects/racket/logging.rkt
@@ -11,10 +11,12 @@
 (provide/contract [with-intercepted-logging
                    (->* ((-> log-event? any)
                          (-> any))
+                        (#:logger logger?)
                         #:rest log-spec?
                         any)]
                   [with-logging-to-port
                    (->* (output-port? (-> any))
+                        (#:logger logger?)
                         #:rest log-spec?
                         any)])
 
@@ -37,12 +39,14 @@
                 (intercept l)
                 (loop)]))))))
 
-(define (with-intercepted-logging interceptor proc . log-spec)
+(define (with-intercepted-logging interceptor proc #:logger [logger #f]
+                                  . log-spec)
   (let* ([orig-logger (current-logger)]
-         ;; We use a local logger to avoid getting messages that didn't
+         ;; Unless we're provided with an explicit logger to monitor 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)]
+         [logger      (or 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)])
@@ -52,8 +56,9 @@
       (channel-put stop-chan 'stop) ; stop the receiver thread
       (thread-wait t))))
 
-(define (with-logging-to-port port proc . log-spec)
+(define (with-logging-to-port port proc #:logger [logger #f] . log-spec)
   (apply with-intercepted-logging
+         #:logger logger
          (lambda (l) (displayln (vector-ref l 1) ; actual message
                                 port))
          proc