mark some flaky synchronization tests
Try out `flaky-test` as a way of marking a test that is not guaranteed to pass (e.g., because it depends on timing), but where many failures in a row are unlikely unless something is broken. Closes #2936
This commit is contained in:
parent
dcc26b1b90
commit
7a12d55e7d
|
@ -8,6 +8,16 @@
|
||||||
racket/list
|
racket/list
|
||||||
(prefix-in k: '#%kernel))
|
(prefix-in k: '#%kernel))
|
||||||
|
|
||||||
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Make sure `flaky-test` works
|
||||||
|
|
||||||
|
(let ([x 0])
|
||||||
|
(define (inc! v)
|
||||||
|
(set! x (+ x v))
|
||||||
|
x)
|
||||||
|
;; Will pass on the thrid try:
|
||||||
|
(flaky-test 3 inc! 1))
|
||||||
|
|
||||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(test '() 'null null)
|
(test '() 'null null)
|
||||||
|
|
|
@ -140,12 +140,12 @@
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
;; Alarms
|
;; Alarms
|
||||||
|
|
||||||
(test #f sync/timeout 0.1 (alarm-evt (+ (current-inexact-milliseconds) 200)))
|
(flaky-test #f sync/timeout 0.1 (alarm-evt (+ (current-inexact-milliseconds) 200)))
|
||||||
(test 'ok sync/timeout 0.1
|
(flaky-test 'ok sync/timeout 0.1
|
||||||
(wrap-evt
|
(wrap-evt
|
||||||
(alarm-evt (+ (current-inexact-milliseconds) 50))
|
(alarm-evt (+ (current-inexact-milliseconds) 50))
|
||||||
(lambda (x) 'ok)))
|
(lambda (x) 'ok)))
|
||||||
(test 'ok sync/timeout 100
|
(flaky-test 'ok sync/timeout 100
|
||||||
(wrap-evt
|
(wrap-evt
|
||||||
(alarm-evt (+ (current-inexact-milliseconds) 50))
|
(alarm-evt (+ (current-inexact-milliseconds) 50))
|
||||||
(lambda (x) 'ok)))
|
(lambda (x) 'ok)))
|
||||||
|
|
|
@ -102,6 +102,8 @@ transcript.
|
||||||
(set! accum-number-of-exn-tests (+ accum-number-of-exn-tests (list-ref l 2)))
|
(set! accum-number-of-exn-tests (+ accum-number-of-exn-tests (list-ref l 2)))
|
||||||
(set! accum-errs (append (list-ref l 3) accum-errs)))))
|
(set! accum-errs (append (list-ref l 3) accum-errs)))))
|
||||||
|
|
||||||
|
(define wrong-result-retries (make-parameter 0))
|
||||||
|
|
||||||
(define test
|
(define test
|
||||||
(let ()
|
(let ()
|
||||||
(define (test* expect fun args kws kvs)
|
(define (test* expect fun args kws kvs)
|
||||||
|
@ -120,14 +122,28 @@ transcript.
|
||||||
(car args))])
|
(car args))])
|
||||||
(printf "~s\n" res)
|
(printf "~s\n" res)
|
||||||
(let ([ok? (equal? expect res)])
|
(let ([ok? (equal? expect res)])
|
||||||
|
(cond
|
||||||
|
[(and (not ok?)
|
||||||
|
(positive? (wrong-result-retries)))
|
||||||
|
(printf "TRY AGAIN\n")
|
||||||
|
(parameterize ([wrong-result-retries (sub1 (wrong-result-retries))])
|
||||||
|
(test* expect fun args kws kvs))]
|
||||||
|
[else
|
||||||
(unless ok?
|
(unless ok?
|
||||||
(record-error (list res expect form))
|
(record-error (list res expect form))
|
||||||
(printf " BUT EXPECTED ~s\n" expect))
|
(printf " BUT EXPECTED ~s\n" expect))
|
||||||
ok?))))
|
ok?])))))
|
||||||
(define (test/kw kws kvs expect fun . args) (test* expect fun args kws kvs))
|
(define (test/kw kws kvs expect fun . args) (test* expect fun args kws kvs))
|
||||||
(define (test expect fun . args) (test* expect fun args #f #f))
|
(define (test expect fun . args) (test* expect fun args #f #f))
|
||||||
(make-keyword-procedure test/kw test)))
|
(make-keyword-procedure test/kw test)))
|
||||||
|
|
||||||
|
;; A flaky test is one that won't always pass, perhaps because it
|
||||||
|
;; is sensitive to timing or GC. But it should pass if we
|
||||||
|
;; try enough times. The test must never error.
|
||||||
|
(define-syntax-rule (flaky-test arg ...)
|
||||||
|
(parameterize ([wrong-result-retries 10])
|
||||||
|
(test arg ...)))
|
||||||
|
|
||||||
(define (nonneg-exact? x)
|
(define (nonneg-exact? x)
|
||||||
(and (exact? x)
|
(and (exact? x)
|
||||||
(integer? x)
|
(integer? x)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user