diff --git a/collects/tests/racket/benchmarks/places/place-channel.rktl b/collects/tests/racket/benchmarks/places/place-channel.rktl index 75438cb332..1f8e778c50 100644 --- a/collects/tests/racket/benchmarks/places/place-channel.rktl +++ b/collects/tests/racket/benchmarks/places/place-channel.rktl @@ -1,7 +1,9 @@ #lang racket/base ;; stress tests for place-channels (require (prefix-in pp: "place-processes.rkt")) -(require racket/place) +(require racket/place + racket/path + racket/system) (define (splat txt fn) (call-with-output-file fn #:exists 'replace @@ -10,8 +12,19 @@ (define (print-out msg B/sE) (displayln (list msg - (exact->inexact B/sE) - (exact->inexact (/ B/sE (* 1024 1024)))))) + (exact->inexact B/sE) 'bytes-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) (let ([pl @@ -33,7 +46,7 @@ (pp:place-channel-receive pl))) null)) - (print-out "processes" (/ (* 2 count message-size) (/ t2 1000))) + (print-out "processes-emulated-places" (/ (* 2 count message-size) (/ t2 1000))) (pp:place-wait pl))) @@ -46,7 +59,7 @@ (define (place-main ch) (define message-size (* 4024 1024)) - (define count 50) + (define count 150) (define fourk-b-message (make-bytes message-size 66)) (for ([i (in-range count)]) (place-channel-receive ch) @@ -58,7 +71,7 @@ END (let ([pl (place "pct1.ss" 'place-main)]) (define message-size (* 4024 1024)) (define four-k-message (make-bytes message-size 65)) - (define count 50) + (define count 150) (define-values (r t1 t2 t3) (time-apply (lambda () (for ([i (in-range count)]) @@ -96,11 +109,47 @@ END (place-channel-send pl tree) (place-channel-receive pl))) null)) + (define s (* (- (expt 2 9) 1) 4 8 count)) + (printf "cons-tree ~a ~a ~a ~a\n" t1 t2 t3 (exact->inexact (/ t2 1000))) + (print-out "cons-tree" (/ s (/ t2 1000))) - (printf "~a ~a ~a ~a\n" r t1 t2 t3) (place-wait pl))) +(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 "/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)]) + (define message-size (* 4024 1024)) + (define four-k-message (make-bytes message-size 65)) + (define count 10) + (define-values (r t1 t2 t3) + (time-apply (lambda () + (write + `(for ([x (in-range ,count)]) + (define k (read)) + (write k) + (flush-output)) _in) + (flush-output _in) + (for ([i (in-range count)]) + (write four-k-message _in) + (flush-output _in) + (read _out))) + null)) + (subprocess-wait _process-handle) + (printf "~a ~a ~a ~a\n" r t1 t2 t3) + + (print-out "process-pipe" (/ (* 2 count message-size) (/ (+ t2 1) 1000))))) + +(define (say-system cmd) + (displayln cmd) + (system cmd)) + (byte-message-test) (processes-byte-message-test) +(process-pipe-test) +(say-system "dd if=/dev/zero of=/dev/null count=10000000") +(say-system "dd if=/dev/zero count=10000000 |dd of=/dev/null") + (cons-tree-test)