1module Random1283 (main) where 2 3import Control.Concurrent 4import Control.Monad 5import Data.Sequence (Seq, ViewL(..), empty, fromList, viewl, (<|), (|>), (><)) 6import System.Random 7 8-- This test 9 10threads, samples :: Int 11threads = 4 12samples = 5000 13 14main :: IO () 15main = loopTest threads samples 16 17loopTest :: Int -> Int -> IO () 18loopTest t s = do 19 isClean <- testRace t s 20 unless isClean $ putStrLn "race condition!" 21 22testRace :: Int -> Int -> IO Bool 23testRace t s = do 24 ref <- liftM (take (t*s) . randoms) getStdGen 25 iss <- threadRandoms t s 26 return (isInterleavingOf (ref::[Int]) iss) 27 28threadRandoms :: Random a => Int -> Int -> IO [[a]] 29threadRandoms t s = do 30 vs <- sequence $ replicate t $ do 31 v <- newEmptyMVar 32 _ <- forkIO (sequence (replicate s randomIO) >>= putMVar v) 33 return v 34 mapM takeMVar vs 35 36isInterleavingOf :: Eq a => [a] -> [[a]] -> Bool 37isInterleavingOf xs' yss' = iio xs' (viewl $ fromList yss') EmptyL where 38 iio (x:xs) ((y:ys) :< yss) zss 39 | x /= y = iio (x:xs) (viewl yss) (viewl (fromViewL zss |> (y:ys))) 40 | x == y = iio xs (viewl ((ys <| yss) >< fromViewL zss)) EmptyL 41 iio xs ([] :< yss) zss = iio xs (viewl yss) zss 42 iio [] EmptyL EmptyL = True 43 iio _ _ _ = False 44 45fromViewL :: ViewL a -> Seq a 46fromViewL EmptyL = empty 47fromViewL (x :< xs) = x <| xs 48 49