Use atomicModifyIORef' (strict) (GHC #4218)
authorThomas Miedema <thomasmiedema@gmail.com>
Thu, 10 Jul 2014 19:01:44 +0000 (21:01 +0200)
committerThomas Miedema <thomasmiedema@gmail.com>
Thu, 10 Jul 2014 19:15:23 +0000 (21:15 +0200)
System/Random.hs
random.cabal
tests/TestRandomIOs.hs [new file with mode: 0644]

index 665dd78..7522499 100644 (file)
@@ -553,7 +553,7 @@ theStdGen  = unsafePerformIO $ do
 -- |Applies 'split' to the current global random generator,
 -- updates it with one of the results, and returns the other.
 newStdGen :: IO StdGen
-newStdGen = atomicModifyIORef theStdGen split
+newStdGen = atomicModifyIORef' theStdGen split
 
 {- |Uses the supplied function to get a value from the current global
 random generator, and updates the global generator with the new generator
@@ -566,7 +566,7 @@ between 1 and 6:
 -}
 
 getStdRandom :: (StdGen -> (a,StdGen)) -> IO a
-getStdRandom f = atomicModifyIORef theStdGen (swap . f)
+getStdRandom f = atomicModifyIORef' theStdGen (swap . f)
   where swap (v,g) = (g,v)
 
 {- $references
index 511ce29..1039057 100644 (file)
@@ -45,3 +45,10 @@ Test-Suite TestRandomRs
     ghc-options:    -rtsopts -O2
     -- TODO. Why does the following not work?
     --test-options:   +RTS -M1M -RTS
+
+Test-Suite TestRandomIOs
+    type:           exitcode-stdio-1.0
+    main-is:        TestRandomIOs.hs
+    hs-source-dirs: tests
+    build-depends:  base >= 3 && < 5, random
+    ghc-options:    -rtsopts -O2
diff --git a/tests/TestRandomIOs.hs b/tests/TestRandomIOs.hs
new file mode 100644 (file)
index 0000000..d8a00cc
--- /dev/null
@@ -0,0 +1,20 @@
+-- Test for ticket #4218 (TestRandomIOs):
+-- https://ghc.haskell.org/trac/ghc/ticket/4218
+--
+-- Used to fail with:
+--
+-- $ cabal test TestRandomIOs --test-options="+RTS -M1M -RTS"
+-- TestRandomIOs: Heap exhausted;
+
+module Main where
+
+import Control.Monad (replicateM)
+import System.Random (randomIO)
+
+-- Build a list of 5000 random ints in memory (IO Monad is strict), and print
+-- the last one.
+-- Should use less than 1Mb of heap space, or we are generating a list of
+-- unevaluated thunks.
+main = do
+    rs <- replicateM 5000 randomIO :: IO [Int]
+    print $ last rs