From a71a45e41f4b90bdb5196f17d3c78fc83f379caa Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 22 Jun 2011 17:18:11 -0400
Subject: [PATCH] Relocate TR logging capture.

---
 collects/tests/typed-scheme/optimizer/run.rkt | 13 ++++---------
 collects/typed-scheme/optimizer/logging.rkt   | 15 ++++++++++++---
 2 files changed, 16 insertions(+), 12 deletions(-)

diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt
index cda41cb09b..17e85be40b 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-scheme/optimizer/run.rkt
@@ -1,8 +1,7 @@
 #lang racket
 (require racket/runtime-path
          rackunit rackunit/text-ui
-         typed-scheme/optimizer/logging
-         unstable/logging)
+         typed-scheme/optimizer/logging)
 
 (provide optimization-tests missed-optimization-tests
          test-opt test-missed-optimization test-file?
@@ -12,19 +11,15 @@
   ;; some tests require other tests, so some fiddling is required
   (with-output-to-string
     (lambda ()
-      (with-intercepted-logging ; catch opt logs
-       (lambda (l)
-         (when (eq? (vector-ref l 2) ; look only for optimizer messages
-                    optimization-log-key)
-           (displayln (vector-ref l 1)))) ; print log message
+      (with-tr-logging-to-port
+       (current-output-port)
        (lambda ()
          (parameterize
              ([current-namespace (make-base-empty-namespace)]
               [current-load-relative-directory dir])
            (dynamic-require
             (build-path (current-load-relative-directory) name)
-            #f)))
-       #:level 'warning))))
+            #f)))))))
 
 ;; we log optimizations and compare to an expected log to make sure that all
 ;; the optimizations we expected did indeed happen
diff --git a/collects/typed-scheme/optimizer/logging.rkt b/collects/typed-scheme/optimizer/logging.rkt
index dcda86a412..b94a5660ed 100644
--- a/collects/typed-scheme/optimizer/logging.rkt
+++ b/collects/typed-scheme/optimizer/logging.rkt
@@ -1,12 +1,12 @@
 #lang racket/base
 
 (require racket/set racket/string racket/match racket/list
-         unstable/syntax
+         unstable/syntax unstable/logging
          "../utils/tc-utils.rkt")
 
 (provide log-optimization log-missed-optimization
-         optimization-log-key
-         print-log clear-log)
+         print-log clear-log
+         with-tr-logging-to-port)
 
 (define (line+col->string stx)
   (let ([line (syntax-line stx)]
@@ -189,3 +189,12 @@
                                     (or (syntax-position x) 0))))
                  ", "))
         kind)))
+
+(define (with-tr-logging-to-port port thunk)
+  (with-intercepted-logging ; catch opt logs
+   (lambda (l)
+     (when (eq? (vector-ref l 2) ; look only for optimizer messages
+                optimization-log-key)
+       (displayln (vector-ref l 1) port))) ; print log message
+   thunk
+   #:level 'warning))