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

Have optimizer test harness look only at log messages that came from the optimizer.

Browse Source 
original commit: 28692786b3dd95bdc7725a247a60ca04fe1d84b6
This commit is contained in:
Vincent St-Amour 2011-06-01 16:53:27 -04:00
parent 7dca73dd33
commit 22d40980c3
1 changed files with 18 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,6 +1,7 @@
#lang racket
(require racket/runtime-path
rackunit rackunit/text-ui
typed-scheme/optimizer/utils
unstable/logging)
(provide optimization-tests missed-optimization-tests
@ -8,23 +9,25 @@
(define (generate-log name dir)
;; some tests require other tests, so some fiddling is required
(let* ([log-port (open-output-string)]
[out-string
(with-output-to-string
(lambda ()
(with-logging-to-port log-port ; catch opt logs
(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)))])
(let ([out-string
(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
(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)))])
;; have the log as an sexp, since that's what the expected log is
(with-input-from-string
(string-append "(" (get-output-string log-port) ; join log and results
" " out-string ")")
(string-append "(" out-string ")")
read)))
;; we log optimizations and compare to an expected log to make sure that all