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

make non-determinstic test less likely to fail

Browse Source 
A test tries to fill a TCP output stream so that it's no longer ready
for writing. There's no real guarantee that it's possible to setup up
and detect that situation, and a failure or two is not too suspicious,
but it really should be possible to fill the buffer. Trying 5 times
should make failure of the test especially unlikely in practice.
This commit is contained in:
Matthew Flatt 2014-07-16 11:48:50 +01:00
parent 83a203c461
commit 70c2f72166
1 changed files with 21 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
pkgs/racket-pkgs/racket-test/tests/racket/thread.rktl
View File

@ -700,20 +700,31 @@
;; Fill up output buffer:
(test sw sync/timeout 0 sw)
(test #t
positive?
(let loop ([n 0])
(if (and (sync/timeout 0 sw)
(= 4096 (write-bytes-avail (make-bytes 4096 (char->integer #\x)) sw)))
(loop (add1 n))
n)))
(test #f sync/timeout 0 sw sr)
(test cr sync sw sr cr) ; sync/timeout 0 might work, but it depends on the underlying transport
(test 'ok
values
(let retry-loop ([m 5])
(cond
[(zero? m)
;; Couldn't get the output port filled, which is susipcious
'could-not-fill]
[else
;; Fill:
(let loop ([n 0])
(if (and (sync/timeout 0 sw)
(positive? (write-bytes-avail (make-bytes 4096 (char->integer #\x)) sw)))
(loop (add1 n))
n))
(if (and (eq? #f (sync/timeout 0 sw sr))
(eq? cr (sync sw sr cr)))
;; It worked:
'ok
;; Try again:
(retry-loop (sub1 m)))])))
;; Flush cr:
(let ([s (make-bytes 4096)])
(let loop ()
(when (and (char-ready? cr)
(= 4096 (read-bytes-avail! s cr)))
(positive? (read-bytes-avail! s cr)))
(loop))))
(close-output-port sw)