Bryan O'Sullivan avatar Bryan O'Sullivan committed 44a75cb

Tried testing actions on stdin/stdout, but failed

They turned out to be too racy and ugly to deal with, due to sharing
across multiple threads.

Comments (0)

Files changed (2)


 import qualified SlowFunctions as Slow
 import QuickCheckUtils (NotEmpty(..), small, genUnicode)
-import TestUtils (withTempFile)
+import TestUtils (withRedirect, withTempFile)
 -- Ensure that two potentially bottom values (in the sense of crashing
 -- for some inputs, not looping infinitely) either both crash, or both
                   r <- reader h'
                   r `deepseq` return r
+t_put_get = write_read T.unlines T.filter put get
+  where put h = withRedirect h stdout . T.putStr
+        get h = withRedirect h stdin T.getContents
+tl_put_get = write_read TL.unlines TL.filter put get
+  where put h = withRedirect h stdout . TL.putStr
+        get h = withRedirect h stdin TL.getContents
 t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents
 tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents
     testProperty "tl_write_read" tl_write_read,
     testProperty "t_write_read_line" t_write_read_line,
     testProperty "tl_write_read_line" tl_write_read_line
+    -- These tests are subject to I/O race conditions when run under
+    -- test-framework-quickcheck2.
+    -- testProperty "t_put_get" t_put_get
+    -- testProperty "tl_put_get" tl_put_get
   testGroup "lowlevel" [


 module TestUtils
-      withTempFile
+      withRedirect
+    , withTempFile
     ) where
-import Control.Exception (bracket)
+import Control.Exception (bracket, bracket_)
 import Control.Monad (when)
+import GHC.IO.Handle.Internals (withHandle)
 import System.Directory (removeFile)
-import System.IO (Handle, hClose, hIsOpen, openTempFile)
+import System.IO
 withTempFile :: (FilePath -> Handle -> IO a) -> IO a
 withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry
       open <- hIsOpen h
       when open (hClose h)
       removeFile path
+withRedirect :: Handle -> Handle -> IO a -> IO a
+withRedirect tmp h = bracket_ swap swap
+  where
+    whenM p a = p >>= (`when` a)
+    swap = do
+      whenM (hIsOpen tmp) $ whenM (hIsWritable tmp) $ hFlush tmp
+      whenM (hIsOpen h) $ whenM (hIsWritable h) $ hFlush h
+      withHandle "spam" tmp $ \tmph -> do
+        hh <- withHandle "spam" h $ \hh ->
+          return (tmph,hh)
+        return (hh,())
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.