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

Make benchmark code run in parallel.

Browse Source 
original commit: bda8c24d2c52af4688148db6646ede46439ec6aa
This commit is contained in:
Eric Dobson 2013-06-22 16:15:36 -07:00
parent 2f2f261dad
commit 70e671189e
3 changed files with 44 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/main.rkt
View File

@ -54,7 +54,8 @@
(define p* (build-path path p))
(define prm (list path p
(if (places)
(run-in-other-place p* error?)
(delay/thread
(run-in-other-place p* error?))
(delay
(parameterize ([read-accept-reader #t]
[current-load-relative-directory path]
@ -96,14 +97,18 @@
(define shootout (collection-path "tests" "racket" "benchmarks" "shootout" "typed"))
(define common (collection-path "tests" "racket" "benchmarks" "common" "typed"))
(define (mk dir)
(make-test-suite (path->string dir)
(for/list ([file (in-list (directory-list dir))]
#:when (scheme-file? file))
(test-suite (path->string file)
(check-not-exn (λ ()
(get-module-code (build-path dir file)
#:choose (lambda (src zo so) 'src))))))))
(test-suite "compiling"
(let ((promised-results
(for/hash ([file (in-list (directory-list dir))]
#:when (scheme-file? file))
(values (path->string file)
(delay/thread (compile-path (build-path dir file)))))))
(make-test-suite (path->string dir)
(for/list ([(name results) promised-results])
(test-suite name
(check-not-exn (λ () (force results))))))))
(test-suite "Compiling Benchmark tests"
(mk shootout)
(mk common)))

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

@ -2,7 +2,7 @@
(require racket/place typed-racket/optimizer/logging
unstable/open-place syntax/modcode data/queue)
(provide start-worker dr serialize-exn deserialize-exn s-exn? generate-log/place verbose?)
(provide start-worker dr serialize-exn deserialize-exn s-exn? generate-log/place compile-path/place verbose?)
(define verbose? (make-parameter #f))
@ -50,6 +50,12 @@
(define lg (generate-log/place name dir))
(place-channel-put res lg))
(loop)]
[(vector 'compile path res)
(with-handlers ([exn:fail?
(λ (e) (place-channel-put res (serialize-exn e)))])
(compile-path/place path)
(place-channel-put res (void)))
(loop)]
[(vector p* res error?)
(define-values (path p b) (split-path p*))
(with-handlers ([exn? (λ (e) (place-channel-put res (serialize-exn e)))])
@ -63,6 +69,12 @@
(place-channel-put res #t)))
(loop)]))))
(define (compile-path/place path)
(get-module-code
path
#:choose (lambda (src zo so) 'src)))
(define-namespace-anchor anchor)
(define (generate-log/place name dir)

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

@ -3,7 +3,7 @@
(require "places.rkt")
(require racket/place data/queue racket/async-channel)
(provide generate-log start-workers run-in-other-place places verbose?)
(provide generate-log start-workers run-in-other-place places verbose? compile-path)
(define places (make-parameter (and (place-enabled?) (min 8 (processor-count)))))
@ -13,18 +13,17 @@
(for ([i (places)])
(start-worker deq-ch i))))
(define (run-in-other-place p* [error? #f])
(define (run-in-other-place p* error?)
(define-values (res-ch res-ch*) (place-channel))
(place-channel-put enq-ch (vector p* res-ch* error?))
(delay/thread
(define res (place-channel-get res-ch))
(when (s-exn? res)
(raise (deserialize-exn res)))))
(define res (place-channel-get res-ch))
(when (s-exn? res)
(raise (deserialize-exn res))))
(define (generate-log name dir)
(apply values
(cond [(places)
(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))
@ -33,3 +32,14 @@
res)]
[else
(generate-log/place name dir)])))
(define (compile-path file)
(cond [(places)
(define-values (res-ch res-ch*) (place-channel))
(place-channel-put enq-ch (vector 'compile file res-ch*))
(define res (place-channel-get res-ch))
(if (s-exn? res)
(raise (deserialize-exn res))
res)]
[else
(compile-path/place file)]))