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

Cleanup place-channel benchmark use read-bytes

Browse Source
This commit is contained in:
Kevin Tew 2011-06-07 14:28:11 -06:00
parent d732c12b96
commit dd4ee47ecd
1 changed files with 21 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
collects/tests/racket/benchmarks/places/place-channel.rktl
View File

@ -15,17 +15,6 @@
(exact->inexact B/sE) 'bytes-per-second (exact->inexact B/sE) 'bytes-per-second
(exact->inexact (/ B/sE (* 1024 1024))) 'MB-per-second))) (exact->inexact (/ B/sE (* 1024 1024))) 'MB-per-second)))
(define (current-executable-path)
(parameterize ([current-directory (find-system-path 'orig-dir)])
(find-executable-path (find-system-path 'exec-file) #f)))
(define (current-collects-path)
(let ([p (find-system-path 'collects-dir)])
(if (complete-path? p)
p
(path->complete-path p (or (path-only (current-executable-path))
(find-system-path 'orig-dir))))))
(define (processes-byte-message-test) (define (processes-byte-message-test)
(let ([pl (let ([pl
(pp:place/base (bo ch) (pp:place/base (bo ch)
@ -115,27 +104,38 @@ END
(place-wait pl))) (place-wait pl)))
(define (current-executable-path)
(parameterize ([current-directory (find-system-path 'orig-dir)])
(find-executable-path (find-system-path 'exec-file) #f)))
(define (current-collects-path)
(let ([p (find-system-path 'collects-dir)])
(if (complete-path? p)
p
(path->complete-path p (or (path-only (current-executable-path))
(find-system-path 'orig-dir))))))
(define (process-pipe-test) (define (process-pipe-test)
(define worker-cmdline-list (list (current-executable-path) "-X" (path->string (current-collects-path)) "-e" "(eval(read))")) (define worker-cmdline-list (list (current-executable-path) "-X" (path->string (current-collects-path)) "-e" "(eval(read))"))
;(define worker-cmdline-list (list "/bin/cat" "/etc/passwd"))
;(let-values ([(_process-handle _out _in _err) (apply subprocess (current-output-port) #f (current-error-port) worker-cmdline-list)])
(let-values ([(_process-handle _out _in _err) (apply subprocess #f #f (current-error-port) worker-cmdline-list)]) (let-values ([(_process-handle _out _in _err) (apply subprocess #f #f (current-error-port) worker-cmdline-list)])
(define message-size (* 4024 1024)) (define message-size (* 4024 1024))
(define four-k-message (make-bytes message-size 65)) (define four-k-message (make-bytes message-size 65))
(define count 10) (define count 10)
(define-values (r t1 t2 t3) (define-values (r t1 t2 t3)
(time-apply (lambda () (begin
(write (write
`(for ([x (in-range ,count)]) `(for ([x (in-range ,count)])
(define k (read)) (define k (read-bytes (* 4024 1024)))
(write k) (write-bytes k)
(flush-output)) _in) (flush-output)) _in)
(flush-output _in) (flush-output _in)
(for ([i (in-range count)]) (time-apply
(write four-k-message _in) (lambda ()
(flush-output _in) (for ([i (in-range count)])
(read _out))) (write-bytes four-k-message _in)
null)) (flush-output _in)
(read-bytes message-size _out)))
null)))
(subprocess-wait _process-handle) (subprocess-wait _process-handle)
(printf "~a ~a ~a ~a\n" r t1 t2 t3) (printf "~a ~a ~a ~a\n" r t1 t2 t3)