Don't add other files TR logs to optimization tests.

This commit is contained in:
Eric Dobson 2013-06-21 09:34:57 -07:00
parent ed69691016
commit f6a0494f65
2 changed files with 19 additions and 8 deletions

View File

@ -1,9 +1,7 @@
#;#; #;#;
#<<END #<<END
TR info: multi-file1.rkt 13:2 (* x (ann 3 Integer)) -- exact real arith TR opt: multi-file2.rkt 14:10 (+ 3 5) -- fixnum bounded expr
TR missed opt: multi-file1.rkt 13:2 (* x (ann 3 Integer)) -- all args float-arg-expr, result not Float -- caused by: 13:12 3 TR opt: multi-file2.rkt 14:3 (* 3.4 (+ 3 5)) -- binary float
TR opt: multi-file2.rkt 16:10 (+ 3 5) -- fixnum bounded expr
TR opt: multi-file2.rkt 16:3 (* 3.4 (+ 3 5)) -- binary float
END END
#<<END #<<END
81.6 81.6

View File

@ -70,6 +70,9 @@
(define file (simplify-path (build-path dir name))) (define file (simplify-path (build-path dir name)))
(define orig-load/use-compiled (current-load/use-compiled)) (define orig-load/use-compiled (current-load/use-compiled))
(define orig-use-compiled-file-paths (use-compiled-file-paths)) (define orig-use-compiled-file-paths (use-compiled-file-paths))
(define full-tr-logs (make-queue))
(define sub-tr-logs (make-queue))
(define (test-load/use-compiled path name) (define (test-load/use-compiled path name)
(parameterize [(use-compiled-file-paths null) (parameterize [(use-compiled-file-paths null)
(current-load/use-compiled reset-load/use-compiled)] (current-load/use-compiled reset-load/use-compiled)]
@ -77,14 +80,16 @@
(define (reset-load/use-compiled path name) (define (reset-load/use-compiled path name)
(parameterize [(use-compiled-file-paths orig-use-compiled-file-paths) (parameterize [(use-compiled-file-paths orig-use-compiled-file-paths)
(current-load/use-compiled orig-load/use-compiled)] (current-load/use-compiled orig-load/use-compiled)]
(orig-load/use-compiled path name))) (with-tr-logging-to-queue
(define tr-logs (make-queue)) sub-tr-logs
(thunk
(orig-load/use-compiled path name)))))
(define regular-output (define regular-output
(with-output-to-string (with-output-to-string
(lambda () (lambda ()
(with-tr-logging-to-queue (with-tr-logging-to-queue
tr-logs full-tr-logs
(thunk (thunk
(parameterize ([current-namespace (make-base-empty-namespace)] (parameterize ([current-namespace (make-base-empty-namespace)]
[current-load/use-compiled test-load/use-compiled]) [current-load/use-compiled test-load/use-compiled])
@ -92,4 +97,12 @@
(namespace-attach-module orig-namespace 'racket) (namespace-attach-module orig-namespace 'racket)
(namespace-attach-module orig-namespace 'typed-racket/core) (namespace-attach-module orig-namespace 'typed-racket/core)
(dynamic-require file #f))))))) (dynamic-require file #f)))))))
(list (sort (queue->list tr-logs) string<?) regular-output))
(define tr-logs
(let ((tr-logs (queue->list full-tr-logs)))
(sort
(for/fold ((tr-logs tr-logs)) ((entry (in-queue sub-tr-logs)))
(remove entry tr-logs))
string<?)))
(list tr-logs regular-output))