1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module System.IO.Streams.Tests.Process (tests) where
------------------------------------------------------------------------------
import Control.Concurrent
import Control.Exception
import Control.Monad (liftM, void)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as S
import qualified System.IO.Streams as Streams
import System.Timeout
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test)
------------------------------------------------------------------------------
tests :: [Test]
#ifndef ENABLE_PROCESS_TESTS
tests = []
#else
tests = [ testInteractiveCommand
, testInteractiveProcess
]
------------------------------------------------------------------------------
testInteractiveCommand :: Test
testInteractiveCommand = testCase "process/interactiveCommand" $ do
(out, err) <- Streams.runInteractiveCommand "cat" >>= run [expected]
assertEqual "interactiveCommand" expected out
assertEqual "interactiveCommand" "" err
where
expected = "testing 1-2-3"
------------------------------------------------------------------------------
testInteractiveProcess :: Test
testInteractiveProcess = testCase "process/interactiveProcess" $ do
(out, err) <- Streams.runInteractiveProcess "tr" ["a-z", "A-Z"]
Nothing Nothing
>>= run [inputdata]
assertEqual "interactiveProcess" expected out
assertEqual "interactiveProcess" "" err
where
inputdata = "testing 1-2-3"
expected = "TESTING 1-2-3"
------------------------------------------------------------------------------
run :: [ByteString]
-> (Streams.OutputStream ByteString,
Streams.InputStream S.ByteString,
Streams.InputStream S.ByteString,
Streams.ProcessHandle)
-> IO (S.ByteString, S.ByteString)
run input (stdin, stdout, stderr, processHandle) = tout 5000000 $ do
me <- myThreadId
outM <- newEmptyMVar
errM <- newEmptyMVar
bracket (mkThreads me outM errM) killThreads $ go outM errM
where
tout t m = timeout t m >>= maybe (error "timeout") return
barfTo me (e :: SomeException) = throwTo me e
killMe restore me m =
void (try (restore m) >>= either (barfTo me) return)
mkThreads me outM errM = mask $ \restore -> do
tid1 <- forkIO $ killMe restore me $ snarf stdout outM
tid2 <- forkIO $ killMe restore me $ snarf stderr errM
return (tid1, tid2)
killThreads (t1, t2) = do
mapM_ killThread [t1, t2]
Streams.waitForProcess processHandle
go outM errM _ = do
Streams.fromList input >>= Streams.connectTo stdin
out <- takeMVar outM
err <- takeMVar errM
return (out, err)
snarf is mv = liftM S.concat (Streams.toList is) >>= putMVar mv
-- ENABLE_PROCESS_TESTS
#endif
|
