suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Relocate TR logging capture.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-06-22 17:18:11 -04:00
parent 101feb8200
commit a71a45e41f
2 changed files with 16 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/tests/typed-scheme/optimizer/run.rkt
View File

@ -1,8 +1,7 @@
#lang racket #lang racket
(require racket/runtime-path (require racket/runtime-path
rackunit rackunit/text-ui rackunit rackunit/text-ui
typed-scheme/optimizer/logging typed-scheme/optimizer/logging)
unstable/logging)
(provide optimization-tests missed-optimization-tests (provide optimization-tests missed-optimization-tests
test-opt test-missed-optimization test-file? test-opt test-missed-optimization test-file?
@ -12,19 +11,15 @@
;; some tests require other tests, so some fiddling is required ;; some tests require other tests, so some fiddling is required
(with-output-to-string (with-output-to-string
(lambda () (lambda ()
(with-intercepted-logging ; catch opt logs (with-tr-logging-to-port
(lambda (l) (current-output-port)
(when (eq? (vector-ref l 2) ; look only for optimizer messages
optimization-log-key)
(displayln (vector-ref l 1)))) ; print log message
(lambda () (lambda ()
(parameterize (parameterize
([current-namespace (make-base-empty-namespace)] ([current-namespace (make-base-empty-namespace)]
[current-load-relative-directory dir]) [current-load-relative-directory dir])
(dynamic-require (dynamic-require
(build-path (current-load-relative-directory) name) (build-path (current-load-relative-directory) name)
#f))) #f)))))))
#:level 'warning))))
;; we log optimizations and compare to an expected log to make sure that all ;; we log optimizations and compare to an expected log to make sure that all
;; the optimizations we expected did indeed happen ;; the optimizations we expected did indeed happen

15
collects/typed-scheme/optimizer/logging.rkt
View File

@ -1,12 +1,12 @@
#lang racket/base #lang racket/base
(require racket/set racket/string racket/match racket/list (require racket/set racket/string racket/match racket/list
unstable/syntax unstable/syntax unstable/logging
"../utils/tc-utils.rkt") "../utils/tc-utils.rkt")
(provide log-optimization log-missed-optimization (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) (define (line+col->string stx)
(let ([line (syntax-line stx)] (let ([line (syntax-line stx)]
@ -189,3 +189,12 @@
(or (syntax-position x) 0)))) (or (syntax-position x) 0))))
", ")) ", "))
kind))) 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))