diff --git a/pkgs/racket-test-core/tests/racket/basic.rktl b/pkgs/racket-test-core/tests/racket/basic.rktl index d600534ccb..e5ca673a67 100644 --- a/pkgs/racket-test-core/tests/racket/basic.rktl +++ b/pkgs/racket-test-core/tests/racket/basic.rktl @@ -8,6 +8,16 @@ racket/list (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) diff --git a/pkgs/racket-test-core/tests/racket/sync.rktl b/pkgs/racket-test-core/tests/racket/sync.rktl index dbd0aa7132..e48da434ff 100644 --- a/pkgs/racket-test-core/tests/racket/sync.rktl +++ b/pkgs/racket-test-core/tests/racket/sync.rktl @@ -140,15 +140,15 @@ ;; ---------------------------------------- ;; Alarms -(test #f sync/timeout 0.1 (alarm-evt (+ (current-inexact-milliseconds) 200))) -(test 'ok sync/timeout 0.1 - (wrap-evt - (alarm-evt (+ (current-inexact-milliseconds) 50)) - (lambda (x) 'ok))) -(test 'ok sync/timeout 100 - (wrap-evt - (alarm-evt (+ (current-inexact-milliseconds) 50)) - (lambda (x) 'ok))) +(flaky-test #f sync/timeout 0.1 (alarm-evt (+ (current-inexact-milliseconds) 200))) +(flaky-test 'ok sync/timeout 0.1 + (wrap-evt + (alarm-evt (+ (current-inexact-milliseconds) 50)) + (lambda (x) 'ok))) +(flaky-test 'ok sync/timeout 100 + (wrap-evt + (alarm-evt (+ (current-inexact-milliseconds) 50)) + (lambda (x) 'ok))) ;; ---------------------------------------- ;; Waitable sets diff --git a/pkgs/racket-test-core/tests/racket/testing.rktl b/pkgs/racket-test-core/tests/racket/testing.rktl index 5191a7f984..46f56f131c 100644 --- a/pkgs/racket-test-core/tests/racket/testing.rktl +++ b/pkgs/racket-test-core/tests/racket/testing.rktl @@ -102,6 +102,8 @@ transcript. (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))))) +(define wrong-result-retries (make-parameter 0)) + (define test (let () (define (test* expect fun args kws kvs) @@ -120,14 +122,28 @@ transcript. (car args))]) (printf "~s\n" res) (let ([ok? (equal? expect res)]) - (unless ok? - (record-error (list res expect form)) - (printf " BUT EXPECTED ~s\n" expect)) - ok?)))) + (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? + (record-error (list res expect form)) + (printf " BUT EXPECTED ~s\n" expect)) + ok?]))))) (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)) (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) (and (exact? x) (integer? x)