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

fix a places test

Browse Source
This commit is contained in:
Matthew Flatt 2013-07-21 16:51:33 -06:00
parent a5f26013ab
commit a5d4186c57
2 changed files with 29 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
pkgs/racket-pkgs/racket-test/tests/racket/benchmarks/places/place-utils.rkt
View File

@ -10,6 +10,7 @@
barrier
places-wait
place/base
place/splat
here-submod
time-n)
@ -44,6 +45,30 @@
(define (name ch)
body ...))]))
(define-syntax (place/splat stx)
(syntax-case stx ()
[(_ (name ch) body ...)
(begin
(define (splat txt fn)
(call-with-output-file fn #:exists 'replace
(lambda (out)
(write txt out))))
(define module-path-prefix (make-temporary-file "place-benchmark~a.rkt"))
(define-values (base file-name isdir) (split-path module-path-prefix))
(define worker-syntax
(with-syntax ([module-name (datum->syntax #'name (string->symbol (path->string (path-replace-suffix file-name ""))))])
#'(module module-name racket/base
(provide name)
(define (name ch)
body ...))))
(define module-path (path->string module-path-prefix))
(splat (syntax->datum worker-syntax) module-path)
(define place-syntax #`(dynamic-place '(file #,module-path) (quote name)))
place-syntax)]))
(define-syntax-rule (here-submod id)
`(submod ,(resolved-module-path-name
(variable-reference->resolved-module-path

8
pkgs/racket-pkgs/racket-test/tests/racket/place.rktl
View File

@ -2,8 +2,8 @@
(Section 'places)
(require "benchmarks/places/place-utils.rkt")
(place-wait (place/base (p1 ch)
(printf "Hello from place\n")))
(place-wait
(place/splat (p1 ch) (printf "Hello from place\n")))
(let ()
(define-values (in out) (place-channel))
@ -50,7 +50,7 @@
(test #t equal? us (car r2))
(test #t equal? us2 (cdr r2))))
(let ([p (place/base (p1 ch)
(let ([p (place/splat (p1 ch)
(printf "Hello form place 2\n")
(exit 99))])
(test #f place? 1)
@ -79,7 +79,7 @@
(err/rt-test (dynamic-place '(quote some-module) 'tfunc))
(let ([p (place/base (p1 ch)
(let ([p (place/splat (p1 ch)
(printf "Hello form place 2\n")
(sync never-evt))])
(place-kill p)