diff options
| author | Andy Wingo <wingo@pobox.com> | 2017-02-20 20:20:42 +0100 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2017-02-20 20:20:42 +0100 |
| commit | fa66c4d4d94b092ae41eedf0f208038d8d045233 (patch) | |
| tree | 37f541b8c0b9b858e7ec9ea6eeebb3ee3928ff4b | |
| parent | Fix deprecation warning in (fibers operations) (diff) | |
| download | guile-fibers-fa66c4d4d94b092ae41eedf0f208038d8d045233.tar.gz | |
Add new channels test.
* tests/channels.scm (pingpong): New test.
| -rw-r--r-- | tests/channels.scm | 22 |
1 files changed, 22 insertions, 0 deletions
diff --git a/tests/channels.scm b/tests/channels.scm index 5a9b58b..67fa9aa 100644 --- a/tests/channels.scm +++ b/tests/channels.scm @@ -71,6 +71,28 @@ (assert-run-fibers-returns (75025) (rpc-fib 24)) +(define (pingpong M N) + (let ((request (make-channel))) + (for-each (lambda (m) + (spawn-fiber (lambda () + (let lp ((n 0)) + (when (< n N) + (let ((reply (make-channel))) + (put-message request reply) + (get-message reply) + (lp (1+ n)))))) + #:parallel? #t)) + (iota M)) + (let lp ((m 0)) + (when (< m M) + (let lp ((n 0)) + (when (< n N) + (put-message (get-message request) 'foo) + (lp (1+ n)))) + (lp (1+ m)))))) + +(assert-run-fibers-terminates (pingpong (current-processor-count) 1000)) + ;; timed channel wait ;; multi-channel wait |
