fix up tests for Windows

threadDelay is not interruptible on Windows with the threaded RTS.
Work around it in conc014, conc015 and conc017, and add a new test for
this specific failure, and mark it as an expected failure for the
relevant cases.

testsuite/tests/ghc-regress/concurrent/should_run/all.T

@@ -129,3 +129,11 @@ test('conc055', exit_code(1), compile_and_run, ['-package stm'])
 test('conc056', only_ways(['threaded1','threaded2']), compile_and_run, ['-package stm -package network'])
 
 test('conc057', only_ways(['threaded2']), compile_and_run, ['-O0'])
+
+if config.platform == "i386-unknown-mingw32":
+    config058 = expect_fail_for(['ghci','threaded1','threaded2'])
+else:
+    config058 = normal
+
+test('conc058', compose(only_compiler_types(['ghc']), config058),
+	 compile_and_run, [''])

testsuite/tests/ghc-regress/concurrent/should_run/conc014.hs

@@ -12,7 +12,14 @@ main = do
      error "wibble"
 	`Control.Exception.catch`
 	    (\e -> do putMVar m (); sum [1..10000] `seq` putStrLn "done.")
-     threadDelay 500000
+     myDelay 500000
    )
     `Control.Exception.catch` (\e -> putStrLn ("caught: " ++ show e))
 
+-- compensate for the fact that threadDelay is non-interruptible
+-- on Windows with the threaded RTS in 6.6.
+myDelay usec = do
+  m <- newEmptyMVar
+  forkIO $ do threadDelay usec; putMVar m ()
+  takeMVar m
+

testsuite/tests/ghc-regress/concurrent/should_run/conc015.hs

@@ -23,10 +23,17 @@ main = do
     block (do
 	putMVar m ()
 	sum [1..10000] `seq` -- give 'foo' a chance to be raised
-  	  (unblock (threadDelay 500000))
+  	  (unblock (myDelay 500000))
 		`Control.Exception.catch` (\e -> putStrLn ("caught1: " ++ show e))
      )
     takeMVar m2
    )
     `Control.Exception.catch`
     (\e -> putStrLn ("caught2: " ++ show e))
+
+-- compensate for the fact that threadDelay is non-interruptible
+-- on Windows with the threaded RTS in 6.6.
+myDelay usec = do
+  m <- newEmptyMVar
+  forkIO $ do threadDelay usec; putMVar m ()
+  takeMVar m

testsuite/tests/ghc-regress/concurrent/should_run/conc017.hs

@@ -21,7 +21,7 @@ main = do
 	(do putMVar m1 () 
 	    unblock (
 		-- unblocked, "foo" delivered to "caught1"
-	       threadDelay 100000
+	       myDelay 100000
 	     )
 	 ) `Control.Exception.catch` (\e -> putStrLn ("caught1: " ++ show e))
 	putMVar m2 ()
@@ -33,3 +33,10 @@ main = do
     takeMVar m3
    ) 
    `Control.Exception.catch` (\e -> putStrLn ("caught3: " ++ show e))
+
+-- compensate for the fact that threadDelay is non-interruptible
+-- on Windows with the threaded RTS in 6.6.
+myDelay usec = do
+  m <- newEmptyMVar
+  forkIO $ do threadDelay usec; putMVar m ()
+  takeMVar m

testsuite/tests/ghc-regress/concurrent/should_run/conc058.hs

+import Control.Concurrent
+import Control.Exception
+
+-- variation on conc020 that tests for threadDelay being interruptible.
+-- On Windows, with the threaded RTS, in 6.6 and earlier, threadDelay is 
+-- not interruptible.
+main = do
+  m <- newEmptyMVar
+  t <- forkIO (block $ threadDelay 1000000)
+  threadDelay 100000
+  throwTo t (ErrorCall "I'm Interruptible")
+  threadDelay 100000
+  putMVar m ()  -- to avoid t being garbage collected

testsuite/tests/ghc-regress/concurrent/should_run/conc058.stderr

+conc058.exe: I'm Interruptible