From 32afbd3b1052197951c0ed7dac549fe65ee6738e Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Sat, 11 Feb 2017 00:43:18 +0300
Subject: [PATCH] Fix sb-concurrency tests on Windows.

Minimal sleep resolution on Windows is around 0.015 so all the tests
that request 0.0001 run for a long time. Do (sleep 0) on Windows.
---
 contrib/sb-concurrency/tests/test-frlock.lisp  |  5 +++--
 contrib/sb-concurrency/tests/test-mailbox.lisp | 21 ++++++++++++++-------
 2 files changed, 17 insertions(+), 9 deletions(-)

diff --git a/contrib/sb-concurrency/tests/test-frlock.lisp b/contrib/sb-concurrency/tests/test-frlock.lisp
index 17353eb13..438fdde4c 100644
--- a/contrib/sb-concurrency/tests/test-frlock.lisp
+++ b/contrib/sb-concurrency/tests/test-frlock.lisp
@@ -85,9 +85,10 @@
       (values (cdr w-e!) (cdr r-e!))))
 
 #+sb-thread
-(deftest* (frlock.1 :fails-on :win32)
+(deftest* (frlock.1)
     (handler-case
-        (sb-ext:with-timeout 60 (test-frlocks))
+        (sb-ext:with-timeout 10
+          (test-frlocks #+win32 :outer-write-pause #+win32 t ))
       (sb-ext:timeout (c)
         (error "~A" c)))
   nil
diff --git a/contrib/sb-concurrency/tests/test-mailbox.lisp b/contrib/sb-concurrency/tests/test-mailbox.lisp
index 618f01860..e68819759 100644
--- a/contrib/sb-concurrency/tests/test-mailbox.lisp
+++ b/contrib/sb-concurrency/tests/test-mailbox.lisp
@@ -46,7 +46,8 @@
                                    (lambda (x)
                                      (loop repeat 50
                                            do (send-message mbox x)
-                                              (sleep 0.001)))
+                                              (sleep #-win32 0.001
+                                                     #+win32 0)))
                                    :arguments i)))
            (readers (loop repeat 10
                           collect (make-thread
@@ -82,7 +83,8 @@
     (&key n-senders n-receivers n-messages interruptor)
   (let ((mbox    (make-mailbox))
         (counter (make-counter))
-        (+sleep+ 0.0001)
+        #-win32
+        (+sleep+  0.0001)
         (+fin-token+ :finish) ; end token for receivers to stop
         (+blksize+ 5))        ; "block size" for RECEIVE-PENDING-MESSAGES
     (multiple-value-bind (n-recv-msg
@@ -97,7 +99,8 @@
                            #'(lambda ()
                                (dotimes (i n-messages t)
                                  (send-message mbox i)
-                                 (sleep (random +sleep+))))))
+                                 (sleep #-win32 (random +sleep+)
+                                        #+win32 0)))))
             (receivers
              (flet ((process-msg (msg out)
                       (cond
@@ -110,20 +113,23 @@
                (append
                 (make-threads n-recv-msg "RECV-MSG"
                   #'(lambda ()
-                      (sleep (random +sleep+))
+                      (sleep  #-win32 (random +sleep+)
+                              #+win32 0)
                       (loop (process-msg (receive-message mbox)
                                          #'(lambda (x) (return x))))))
                 (make-threads n-recv-pend-msgs "RECV-PEND-MSGS"
                   #'(lambda ()
                       (loop
-                        (sleep (random +sleep+))
+                        (sleep #-win32 (random +sleep+)
+                              #+win32 0)
                         (mapc #'(lambda (msg)
                                   (process-msg msg #'(lambda (x) (return x))))
                               (receive-pending-messages mbox +blksize+)))))
                 (make-threads n-recv-msg-n-h "RECV-MSG-NO-HANG"
                   #'(lambda ()
                       (loop
-                        (sleep (random +sleep+))
+                        (sleep #-win32 (random +sleep+)
+                               #+win32 0)
                         (multiple-value-bind (msg ok)
                             (receive-message-no-hang mbox)
                           (when ok
@@ -220,7 +226,8 @@
                           (loop repeat 99
                                 for victim = (nth (random n) threads)
                                 do (kill-thread victim)
-                                   (sleep (random 0.0001)))))
+                                   (sleep  #-win32 (random 0.0001)
+                                           #+win32 0))))
       (values
        ;; We may have killed a receiver before it got to incrementing
        ;; the counter.
-- 
2.11.4.GIT