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

Use module registry trick to slightly speed up TR tests.

Browse Source 
original commit: 26a57f64202a9e4040fe495cf5d6a2ce3d79531f
This commit is contained in:
Sam Tobin-Hochstadt 2012-08-22 11:07:39 -04:00
parent 08962bd0aa
commit 467c46360c
1 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/tests/typed-racket/places.rkt
View File

@ -28,12 +28,15 @@
(exn:fail m (current-continuation-marks))]
[(s-exn m)
(exn m (current-continuation-marks))]))
(define (dr p)
(define (dr p [reg-box #f])
(parameterize ([current-namespace (make-base-empty-namespace)])
(dynamic-require `(file ,(if (string? p) p (path->string p))) #f)))
(dynamic-require `(file ,(if (string? p) p (path->string p))) #f)
(and reg-box (set-box! reg-box (namespace-module-registry (current-namespace))))))
(define (start-worker get-ch name)
(open-place ch
(define reg (box #f))
(let loop ()
(match (place-channel-get get-ch)
[(vector 'log name dir res)
@ -41,7 +44,7 @@
(λ (e) (place-channel-put
res
(string-append "EXCEPTION: " (exn-message e))))])
(define lg (generate-log/place name dir))
(define lg (generate-log/place name dir reg))
(place-channel-put res lg))
(loop)]
[(vector p* res error?)
@ -54,13 +57,13 @@
[error-display-handler (if error? void (error-display-handler))])
(with-handlers ([exn? (λ (e)
(place-channel-put res (serialize-exn e)))])
(dr p)
(dr p reg)
(place-channel-put res #t)))
(loop)]))))
(define comp (compile-zos #f #:module? #t))
(define (generate-log/place name dir)
(define (generate-log/place name dir [reg-box #f])
;; some tests require other tests, so some fiddling is required
(define f (build-path dir name))
(with-output-to-string
@ -72,6 +75,7 @@
(parameterize
([current-namespace (make-base-empty-namespace)]
[current-load-relative-directory dir])
(dynamic-require f #f))
(dynamic-require f #f)
(and reg-box (set-box! reg-box (namespace-module-registry (current-namespace)))))
;; clean up compiled files in prevision of the next testing run
(delete-directory/files (build-path dir "compiled")))))