git.iko.soy/text
on master help sign in
Tried testing actions on stdin/stdout, but failed
ea75ebcBryan O'Sullivan
tests/Properties.hs+11−1
compare with master
unifiedsplit
@@ -39,7 +39,7 @@ import qualified Data.Text.Lazy.Search as S (indices)
39import qualified SlowFunctions as Slow
39import qualified SlowFunctions as Slow
40
40
41import QuickCheckUtils (NotEmpty(..), small, genUnicode)
41import QuickCheckUtils (NotEmpty(..), small, genUnicode)
42−import TestUtils (withTempFile)
42+import TestUtils (withRedirect, withTempFile)
43
43
44-- Ensure that two potentially bottom values (in the sense of crashing
44-- Ensure that two potentially bottom values (in the sense of crashing
45-- for some inputs, not looping infinitely) either both crash, or both
45-- 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 =
636 r <- reader h'
636 r <- reader h'
637 r `deepseq` return r
637 r `deepseq` return r
638
638
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
639t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents
645t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents
640tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents
646tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents
641
647
@@ -1043,6 +1049,10 @@ tests = [
1043 testProperty "tl_write_read" tl_write_read,
1049 testProperty "tl_write_read" tl_write_read,
1044 testProperty "t_write_read_line" t_write_read_line,
1050 testProperty "t_write_read_line" t_write_read_line,
1045 testProperty "tl_write_read_line" tl_write_read_line
1051 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
1046 ],
1056 ],
1047
1057
1048 testGroup "lowlevel" [
1058 testGroup "lowlevel" [
tests/TestUtils.hs+17−3
@@ -1,12 +1,14 @@
1module TestUtils
1module TestUtils
2 (
2 (
3+ withRedirect
3− withTempFile
4+ , withTempFile
4 ) where
5 ) where
5
6
6−import Control.Exception (bracket)
7+import Control.Exception (bracket, bracket_)
7import Control.Monad (when)
8import Control.Monad (when)
9+import GHC.IO.Handle.Internals (withHandle)
8import System.Directory (removeFile)
10import System.Directory (removeFile)
9−import System.IO (Handle, hClose, hIsOpen, openTempFile)
11+import System.IO
10
12
11withTempFile :: (FilePath -> Handle -> IO a) -> IO a
13withTempFile :: (FilePath -> Handle -> IO a) -> IO a
12withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry
14withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry
@@ -15,3 +17,15 @@ withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry
15 open <- hIsOpen h
17 open <- hIsOpen h
16 when open (hClose h)
18 when open (hClose h)
17 removeFile path
19 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,())