git.iko.soy/text
on master help sign in
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. --HG-- extra : convert_revision : 14666f6ca622a5e7e3fc89995fdef262d3d675df

commitea75ebc1f1e3d8d511945883e1e591d176524281 authorBryan O'Sullivan <bos@serpentine.com> dateSun 29 Aug 2010, 04:51 (16 years ago) parentc7bf84f
2 files changed+28−4
compare with master
unifiedsplit
tests/Properties.hs+11−1 tests/TestUtils.hs+17−3
tests/Properties.hs+11−1
@@ -39,7 +39,7 @@ import qualified Data.Text.Lazy.Search as S (indices)
3939import qualified SlowFunctions as Slow
4040
4141import QuickCheckUtils (NotEmpty(..), small, genUnicode)
42−import TestUtils (withTempFile)
42+import TestUtils (withRedirect, withTempFile)
4343
4444-- Ensure that two potentially bottom values (in the sense of crashing
4545-- for some inputs, not looping infinitely) either both crash, or both
@@ -636,6 +636,12 @@ write_read unline filt writer reader (E _ e) m ts =
636636 r <- reader h'
637637 r `deepseq` return r
638638
639+t_put_get = write_read T.unlines T.filter put get
640+ where put h = withRedirect h stdout . T.putStr
641+ get h = withRedirect h stdin T.getContents
642+tl_put_get = write_read TL.unlines TL.filter put get
643+ where put h = withRedirect h stdout . TL.putStr
644+ get h = withRedirect h stdin TL.getContents
639645t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents
640646tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents
641647
@@ -1043,6 +1049,10 @@ tests = [
10431049 testProperty "tl_write_read" tl_write_read,
10441050 testProperty "t_write_read_line" t_write_read_line,
10451051 testProperty "tl_write_read_line" tl_write_read_line
1052+ -- These tests are subject to I/O race conditions when run under
1053+ -- test-framework-quickcheck2.
1054+ -- testProperty "t_put_get" t_put_get
1055+ -- testProperty "tl_put_get" tl_put_get
10461056 ],
10471057
10481058 testGroup "lowlevel" [
tests/TestUtils.hs+17−3
@@ -1,12 +1,14 @@
11module TestUtils
22 (
3− withTempFile
3+ withRedirect
4+ , withTempFile
45 ) where
56
6−import Control.Exception (bracket)
7+import Control.Exception (bracket, bracket_)
78import Control.Monad (when)
9+import GHC.IO.Handle.Internals (withHandle)
810import System.Directory (removeFile)
9−import System.IO (Handle, hClose, hIsOpen, openTempFile)
11+import System.IO
1012
1113withTempFile :: (FilePath -> Handle -> IO a) -> IO a
1214withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry
@@ -15,3 +17,15 @@ withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry
1517 open <- hIsOpen h
1618 when open (hClose h)
1719 removeFile path
20+
21+withRedirect :: Handle -> Handle -> IO a -> IO a
22+withRedirect tmp h = bracket_ swap swap
23+ where
24+ whenM p a = p >>= (`when` a)
25+ swap = do
26+ whenM (hIsOpen tmp) $ whenM (hIsWritable tmp) $ hFlush tmp
27+ whenM (hIsOpen h) $ whenM (hIsWritable h) $ hFlush h
28+ withHandle "spam" tmp $ \tmph -> do
29+ hh <- withHandle "spam" h $ \hh ->
30+ return (tmph,hh)
31+ return (hh,())