diff --git a/CHANGES.txt b/CHANGES.txt
--- a/CHANGES.txt
+++ b/CHANGES.txt
@@ -1,5 +1,8 @@
 Changelog for Extra
 
+1.4.1
+    Make temp file functions workaround GHC bug #10731
+    Add retryBool
 1.4
     Add stripInfix and stripInfixEnd
 1.3.1
diff --git a/extra.cabal b/extra.cabal
--- a/extra.cabal
+++ b/extra.cabal
@@ -1,7 +1,7 @@
 cabal-version:      >= 1.10
 build-type:         Simple
 name:               extra
-version:            1.4
+version:            1.4.1
 license:            BSD3
 license-file:       LICENSE
 category:           Development
@@ -69,8 +69,9 @@
     if !os(windows)
         build-depends: unix
     hs-source-dirs: test
-    ghc-options: -main-is Test
+    ghc-options: -main-is Test -threaded -with-rtsopts=-N4
     main-is:        Test.hs
     other-modules:
-        TestUtil
+        TestCustom
         TestGen
+        TestUtil
diff --git a/src/Control/Exception/Extra.hs b/src/Control/Exception/Extra.hs
--- a/src/Control/Exception/Extra.hs
+++ b/src/Control/Exception/Extra.hs
@@ -1,10 +1,11 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 
 -- | Extra functions for "Control.Exception".
 --   These functions provide retrying, showing in the presence of exceptions,
 --   and functions to catch\/ignore exceptions, including monomorphic (no 'Exception' context) versions.
 module Control.Exception.Extra(
     module Control.Exception,
-    retry,
+    retry, retryBool,
     showException, stringException,
     errorIO,
     -- * Exception catching/ignoring
@@ -64,12 +65,18 @@
 -- > retry 1 (print "x")  == print "x"
 -- > retry 3 (fail "die") == fail "die"
 retry :: Int -> IO a -> IO a
-retry i x | i <= 0 = error "retry count must be 1 or more"
-retry 1 x = x
-retry i x = do
-    res <- try_ x
+retry i x | i <= 0 = error "Control.Exception.Extra.retry: count must be 1 or more"
+retry i x = retryBool (\(e :: SomeException) -> True) i x
+
+-- | Retry an operation at most /n/ times (/n/ must be positive), while the exception value and type match a predicate.
+--   If the operation fails the /n/th time it will throw that final exception.
+retryBool :: Exception e => (e -> Bool) -> Int -> IO a -> IO a
+retryBool p i x | i <= 0 = error "Control.Exception.Extra.retryBool: count must be 1 or more"
+retryBool p 1 x = x
+retryBool p i x = do
+    res <- tryBool p x
     case res of
-        Left _ -> retry (i-1) x
+        Left _ -> retryBool p (i-1) x
         Right v -> return v
 
 
diff --git a/src/Extra.hs b/src/Extra.hs
--- a/src/Extra.hs
+++ b/src/Extra.hs
@@ -8,7 +8,7 @@
     getNumCapabilities, setNumCapabilities, withNumCapabilities, forkFinally, once, onceFork, Lock, newLock, withLock, withLockTry, Var, newVar, readVar, modifyVar, modifyVar_, withVar, Barrier, newBarrier, signalBarrier, waitBarrier, waitBarrierMaybe,
     -- * Control.Exception.Extra
     -- | Extra functions available in @"Control.Exception.Extra"@.
-    retry, showException, stringException, errorIO, ignore, catch_, handle_, try_, catchJust_, handleJust_, tryJust_, catchBool, handleBool, tryBool,
+    retry, retryBool, showException, stringException, errorIO, ignore, catch_, handle_, try_, catchJust_, handleJust_, tryJust_, catchBool, handleBool, tryBool,
     -- * Control.Monad.Extra
     -- | Extra functions available in @"Control.Monad.Extra"@.
     whenJust, whenJustM, unit, loopM, whileM, partitionM, concatMapM, mapMaybeM, findM, firstJustM, whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM,
diff --git a/src/System/IO/Extra.hs b/src/System/IO/Extra.hs
--- a/src/System/IO/Extra.hs
+++ b/src/System/IO/Extra.hs
@@ -24,9 +24,12 @@
 import GHC.IO.Handle(hDuplicate,hDuplicateTo)
 import System.Directory.Extra
 import System.IO.Error
+import System.IO.Unsafe
 import System.FilePath
 import Data.Char
 import Data.Time.Clock
+import Data.Tuple.Extra
+import Data.IORef
 
 
 -- File reading
@@ -131,8 +134,20 @@
     hSetBuffering h m
     act
 
--- Temporary file
 
+---------------------------------------------------------------------
+-- TEMPORARY FILE
+
+{-# NOINLINE tempRef #-}
+tempRef :: IORef Int
+tempRef = unsafePerformIO $ do
+    rand :: Integer <- fmap (read . take 50 . filter isDigit . show . utctDayTime) getCurrentTime
+    newIORef $ fromIntegral rand
+
+tempUnique :: IO Int
+tempUnique = atomicModifyIORef tempRef $ succ &&& succ
+
+
 -- | Provide a function to create a temporary file, and a way to delete a
 --   temporary file. Most users should use 'withTempFile' which
 --   combines these operations.
@@ -144,7 +159,8 @@
     where
         create = do
             tmpdir <- getTemporaryDirectory
-            (file, h) <- openTempFile tmpdir "extra"
+            val <- tempUnique
+            (file, h) <- retryBool (\(_ :: IOError) -> True) 5 $ openTempFile tmpdir $ "extra-file-" ++ show val ++ "-"
             hClose h
             return file
 
@@ -168,21 +184,17 @@
 --   combines these operations.
 newTempDir :: IO (FilePath, IO ())
 newTempDir = do
-        dir <- create
+        tmpdir <- getTemporaryDirectory
+        dir <- retryBool (\(_ :: IOError) -> True) 5 $ create tmpdir
         del <- once $ ignore $ removeDirectoryRecursive dir
         return (dir, del)
     where
-        create = do
-            tmpdir <- getTemporaryDirectory
-            -- get the number of seconds during today (including floating point), and grab some interesting digits
-            rand :: Integer <- fmap (read . take 20 . filter isDigit . show . utctDayTime) getCurrentTime
-            find tmpdir rand
-
-        find tmpdir x = do
-            let dir = tmpdir </> "extra" ++ show x
+        create tmpdir = do
+            v <- tempUnique
+            let dir = tmpdir </> "extra-dir-" ++ show v
             catchBool isAlreadyExistsError
                 (createDirectoryPrivate dir >> return dir) $
-                \e -> find tmpdir (x+1)
+                \e -> create tmpdir
 
 
 -- | Create a temporary directory inside the system temporary directory.
diff --git a/test/Test.hs b/test/Test.hs
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -3,6 +3,7 @@
 
 import TestGen
 import TestUtil
+import TestCustom
 
 -- Check that we managed to export everything
 _unused1 x = whenJust
@@ -14,4 +15,6 @@
 
 
 main :: IO ()
-main = runTests $ tests
+main = runTests $ do
+    tests
+    testCustom
diff --git a/test/TestCustom.hs b/test/TestCustom.hs
new file mode 100644
--- /dev/null
+++ b/test/TestCustom.hs
@@ -0,0 +1,30 @@
+
+module TestCustom(testCustom) where
+
+import Control.Concurrent.Extra
+import Control.Monad
+import System.IO.Extra
+import Data.IORef
+import TestUtil
+
+
+testCustom :: IO ()
+testCustom = do
+    testRaw "withTempFile" $ do
+        xs <- replicateM 4 $ onceFork $ do
+            replicateM_ 100 $ withTempFile (const $ return ())
+            putChar '.'
+        sequence_ xs
+        putStrLn "done"
+
+    testRaw "withTempDir" $ do
+        xs <- replicateM 4 $ onceFork $ do
+            replicateM_ 100 $ withTempDir (const $ return ())
+            putChar '.'
+        sequence_ xs
+        putStrLn "done"
+
+    testGen "retry" $ do
+        ref <- newIORef 2
+        retry 5 $ do modifyIORef ref pred; whenM ((/=) 0 <$> readIORef ref) $ fail "die"
+        (==== 0) <$> readIORef ref
diff --git a/test/TestUtil.hs b/test/TestUtil.hs
--- a/test/TestUtil.hs
+++ b/test/TestUtil.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE ScopedTypeVariables, CPP #-}
 
-module TestUtil(runTests, testGen, erroneous, (====), module X) where
+module TestUtil(runTests, testGen, testRaw, erroneous, (====), module X) where
 
 import Test.QuickCheck
 import Test.QuickCheck.Test
@@ -32,10 +32,14 @@
 testCount = unsafePerformIO $ newIORef 0
 
 testGen :: Testable prop => String -> prop -> IO ()
-testGen msg prop = do
-    putStrLn msg
+testGen msg prop = testRaw msg $ do
     r <- quickCheckResult prop
     unless (isSuccess r) $ error "Test failed"
+
+testRaw :: String -> IO () -> IO ()
+testRaw msg test = do
+    putStrLn msg
+    test
     modifyIORef testCount (+1)
 
 
@@ -56,6 +60,10 @@
     t
     n <- readIORef testCount
     putStrLn $ "Success (" ++ show n ++ " tests)"
+
+instance Testable () where
+    property = property . (`seq` True)
+    exhaustive _ = True
 
 instance Testable a => Testable (IO a) where
     property = property . unsafePerformIO
