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

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)

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

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)