thread-safe getStdRandom and newStdGen

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

Trac metadata

Trac field	Value
Version	6.6
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	libraries/base
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system	Multiple
Architecture	Multiple