Ticket #1283 (closed bug: fixed)
thread-safe getStdRandom and newStdGen
|Reported by:||haskell@…||Owned by:||simonmar|
|Type of failure:||Difficulty:||Easy (less than 1 hour)|
|Test Case:||Blocked By:|
Implementations of getStdRandom and newStdGen use unsynchronised calls to getStdGen and setStdGen, allowing a race condition in which duplicate random numbers can be returned in multiple threads.
Patch attached. Tested against GHC 6.6, on Linux amd64.
The following code used with +RTS -N2 demonstrates the race condition.
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 putStrLn $ if isClean then "no race condition found" else "race condition found" loopTest t s 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