diff --git a/tests/TestRandomRs.hs b/tests/TestRandomRs.hs
new file mode 100644
index 0000000000000000000000000000000000000000..74e319d9341c1a5b9ce3093b1aa970427c13d6cd
--- /dev/null
+++ b/tests/TestRandomRs.hs
@@ -0,0 +1,24 @@
+
+-- Test from ticket #4218:
+-- http://hackage.haskell.org/trac/ghc/ticket/4218
+
+module Main where
+
+import Control.Monad
+import System.Random
+import Data.List
+
+force = foldr (\x r -> x `seq` (x:r)) []
+
+-- Ten million random numbers:
+blowsTheHeap :: IO Integer
+blowsTheHeap = (last . take 10000000 . randomRs (0, 1000000)) `liftM` getStdGen
+
+works :: IO Integer
+works = (last . take 10000000 . force . randomRs (0, 1000000)) `liftM` getStdGen
+
+
+main = 
+ do n <- blowsTheHeap
+    print n
+
diff --git a/tests/rangeTest.hs b/tests/rangeTest.hs
index 88f736d02db4c4afeb4918d51ad8b978be83453e..704a36c717c7582ec7a4f60dfb06892da10d0d54 100644
--- a/tests/rangeTest.hs
+++ b/tests/rangeTest.hs
@@ -58,8 +58,8 @@ main =
  do 
     checkBounds "Int"     (intRange nb)  (approxBounds random trials (undefined::Int))
     checkBounds "Integer" (intRange nb)  (approxBounds random trials (undefined::Integer))
-    checkBounds "Integer Rbig"    (False,-(2^500), 2^500) (approxBounds (randomR (-(2^500), 2^500)) trials (undefined::Integer))
-    checkBounds "Integer RbigPos" (False,1,2^5000)        (approxBounds (randomR (1,2^5000))        trials (undefined::Integer))
+--    checkBounds "Integer Rbig"    (False,-(2^500), 2^500) (approxBounds (randomR (-(2^500), 2^500)) trials (undefined::Integer))
+--    checkBounds "Integer RbigPos" (False,1,2^5000)        (approxBounds (randomR (1,2^5000))        trials (undefined::Integer))
     checkBounds "Int8"    (intRange 8)   (approxBounds random trials (undefined::Int8))
     checkBounds "Int16"   (intRange 16)  (approxBounds random trials (undefined::Int16))
     checkBounds "Int32"   (intRange 32)  (approxBounds random trials (undefined::Int32))
diff --git a/tests/rangeTest.stdout b/tests/rangeTest.stdout
index f9d9479d9900516836d4676243ab809635cc6598..55ccaffb4e62ba7d57f8ae06202f429d32b84b9d 100644
--- a/tests/rangeTest.stdout
+++ b/tests/rangeTest.stdout
@@ -1,7 +1,5 @@
 Int:  Passed
 Integer:  Passed
-Integer Rbig:  Passed
-Integer RbigPos:  Passed
 Int8:  Passed
 Int16:  Passed
 Int32:  Passed
diff --git a/tests/slowness.hs b/tests/slowness.hs
new file mode 100644
index 0000000000000000000000000000000000000000..162a4cff0540ef2f933a1f89e7e51bb9c3c2222b
--- /dev/null
+++ b/tests/slowness.hs
@@ -0,0 +1,55 @@
+
+-- http://hackage.haskell.org/trac/ghc/ticket/427
+
+-- Two (performance) problems in one:
+
+{-# OPTIONS -fffi #-}
+module Main (main) where
+
+import Control.Monad
+import System.Random
+
+foreign import ccall unsafe "random" _crandom :: IO Int
+foreign import ccall unsafe "stdlib.hs" rand :: IO Int
+
+randomInt :: (Int, Int) -> IO Int
+randomInt (min,max) = do
+--    n <- _crandom
+    n <- rand
+    return $ min + n `rem` range
+    where
+        range = max - min + 1
+
+main = replicateM_ (5*10^6) $ do
+    x <- randomRIO (0::Int,1000) :: IO Int
+--    x <- randomInt (0::Int,1000) :: IO Int
+    x `seq` return ()
+    return ()
+
+-- First, without the "seq" at the end, hardly anything is
+-- evaluated and we're building huge amounts of thunks.
+-- Three ideas about this one:
+-- - Blame the user :)
+-- - data StdGen = StdGen !Int !Int
+--   Use strict fields in StdGen. Doesn't actually help
+-- (at least in this example).
+-- - Force evaluation of the StdGen in getStdRandom.
+--   Does help in this example, but also changes behaviour
+-- of the library:
+--   x <- randomRIO undefined
+--   currently dies only when x (or the result of a later
+-- randomRIO) is evaluated. This change causes it to die
+-- immediately.
+
+-- Second, even _with_ the "seq", replacing "randomRIO" by
+-- "randomInt" speeds the thing up with a factor of about
+-- 30. (2 to 3.6, in a "real world" university practicum
+-- exercise of 900 lines of code)
+-- Even given the fact that they're not really doing the
+-- same thing, this seems rather much :(
+
+--------------------------------------------------------------------------------
+
+-- [2011.06.28] RRN:
+-- I'm currently seeing 1425 ms vs 43 ms for the above.  33X
+-- difference. If I use rand() instead it's about 52ms.