add test from #1283

tests/Makefile

+# This Makefile runs the tests using GHC's testsuite framework.  It
+# assumes the package is part of a GHC build tree with the testsuite
+# installed in ../../../testsuite.
+
+TOP=../../../testsuite
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk

tests/all.T

+test('random1283', reqlib('containers'), compile_and_run, ['-package containers'])

tests/random1283.hs

+import Control.Concurrent
+import Control.Monad
+import Data.Sequence hiding (take)
+import System.Random
+
+threads = 4
+samples = 5000
+
+main = loopTest threads samples
+
+loopTest t s = do
+  isClean <- testRace t s
+  when (not isClean) $ putStrLn "race condition!"
+
+testRace t s = do
+  ref <- liftM (take (t*s) . randoms) getStdGen
+  iss <- threadRandoms t s
+  return (isInterleavingOf (ref::[Int]) iss)
+
+threadRandoms t s = do
+  vs <- sequence $ replicate t $ do
+    v <- newEmptyMVar
+    forkIO (sequence (replicate s randomIO) >>= putMVar v)
+    return v
+  mapM takeMVar vs
+
+isInterleavingOf xs yss = iio xs (viewl $ fromList yss) EmptyL where
+  iio (x:xs) ((y:ys) :< yss) zss
+    | x /= y = iio (x:xs) (viewl yss) (viewl (fromViewL zss |> (y:ys)))
+    | x == y = iio xs (viewl ((ys <| yss) >< fromViewL zss)) EmptyL
+  iio xs ([] :< yss) zss = iio xs (viewl yss) zss
+  iio [] EmptyL EmptyL = True
+  iio _ _ _ = False
+
+fromViewL (EmptyL) = empty
+fromViewL (x :< xs) = x <| xs