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
|
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module ShellProtocol (testShellProtocol) where
import Control.Exception
import Control.Monad
import Data.List
import System.Environment
import System.Exit
import System.IO
import System.IO.Silently
import Test.Hspec
testShellProtocol :: IO () -> String -> IO ()
testShellProtocol program shellProtocol = do
let protocol = parseProtocol shellProtocol
testProtocol program protocol
data Protocol
= Protocol {
_args :: [String],
_expected :: [String]
}
deriving (Show)
parseProtocol :: String -> [Protocol]
parseProtocol = inner . lines
where
inner :: [String] -> [Protocol]
inner [] = []
inner ((words -> "$" : "program" : args) : rest) =
let (expected, next) = span (not . ("$ " `isPrefixOf`)) rest in
Protocol args expected : inner next
inner lines = error ("parseProtocol: cannot parse: " ++ show lines)
testProtocol :: IO () -> [Protocol] -> IO ()
testProtocol program protocol = do
forM_ protocol $ \ (Protocol args expected) -> do
output <- hCapture_ [stdout, stderr] $
handle (\ (e :: ExitCode) -> printExitCode e) $
withArgs args $
withProgName "program" $
program
output `shouldBe` unlines expected
printExitCode :: ExitCode -> IO ()
printExitCode e = case e of
ExitFailure n -> hPutStrLn stderr ("# exit-code " ++ show n)
ExitSuccess -> return ()
|
