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

Make tr-log and output be extracted seperately.

Browse Source 
original commit: 87e86d2ea771ef51b87b9e544bbf75269201190d
This commit is contained in:
Eric Dobson 2013-06-20 21:51:28 -07:00
parent be5c82a8db
commit 8e55bc87be
4 changed files with 28 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/run.rkt
View File

@ -16,10 +16,11 @@
(test-begin
;; ugly, but otherwise rackunit spews the entire logs to
;; stderr, and they can be quite long
(define-values (tr-log output) (generate-log name dir))
(check-equal?
;; actual log
(with-input-from-string
(string-append "(" (generate-log name dir) ")")
(string-append "(" tr-log output ")")
read)
;; expected log
(with-input-from-file (build-path dir name)

4
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/transform.rkt
View File

@ -11,7 +11,7 @@
(define (transform file dir)
;; generate the new log, that will become the expected log
(define new-log (generate-log file dir))
(define-values (new-tr-log new-output) (generate-log file dir))
(define in (open-input-file (build-path dir file)))
(read-line in) ; drop the #;
(read in) ; drop the old expected log
@ -20,7 +20,7 @@
(lambda ()
(displayln "#;")
(displayln "#<<END")
(display new-log)
(display (string-append new-tr-log new-output))
(display "\nEND")
(display rest)))))

25
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/places.rkt
View File

@ -78,15 +78,18 @@
(parameterize [(use-compiled-file-paths orig-use-compiled-file-paths)
(current-load/use-compiled orig-load/use-compiled)]
(orig-load/use-compiled path name)))
(define tr-log-output (open-output-string))
(with-output-to-string
(lambda ()
(with-tr-logging-to-port
(current-output-port)
(thunk
(parameterize ([current-namespace (make-base-empty-namespace)]
[current-load/use-compiled test-load/use-compiled])
(define orig-namespace (namespace-anchor->namespace anchor))
(namespace-attach-module orig-namespace 'racket)
(namespace-attach-module orig-namespace 'typed-racket/core)
(dynamic-require file #f)))))))
(define regular-output
(with-output-to-string
(lambda ()
(with-tr-logging-to-port
tr-log-output
(thunk
(parameterize ([current-namespace (make-base-empty-namespace)]
[current-load/use-compiled test-load/use-compiled])
(define orig-namespace (namespace-anchor->namespace anchor))
(namespace-attach-module orig-namespace 'racket)
(namespace-attach-module orig-namespace 'typed-racket/core)
(dynamic-require file #f)))))))
(list (get-output-string tr-log-output) regular-output))

19
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/send-places.rkt
View File

@ -23,12 +23,13 @@
(define (generate-log name dir)
(cond [(places)
(define-values (res-ch res-ch*) (place-channel))
(place-channel-put enq-ch (vector 'log name dir res-ch*))
(define res (place-channel-get res-ch))
(if (s-exn? res)
(raise (deserialize-exn res))
res)]
[else
(generate-log/place name dir)]))
(apply values
(cond [(places)
(define-values (res-ch res-ch*) (place-channel))
(place-channel-put enq-ch (vector 'log name dir res-ch*))
(define res (place-channel-get res-ch))
(if (s-exn? res)
(raise (deserialize-exn res))
res)]
[else
(generate-log/place name dir)])))