diff --git a/shelltestrunner.cabal b/shelltestrunner.cabal --- a/shelltestrunner.cabal +++ b/shelltestrunner.cabal @@ -1,50 +1,64 @@ name: shelltestrunner -version: 0.3 +version: 0.4 category: Testing synopsis: A tool for testing command-line programs. description: - Run a given program through "shell" tests specifed by - one or more test files, each of which specifies: - command-line arguments, input, expected output, - expected stderr output, and expected exit code. This - was extracted from the hledger project, and inspired - by the tests in John Wiegley's ledger project. - - This uses test-framework's test runner. Any command-line - options are passed through to the test-framework runner, - but they must not contain spaces, so use eg -tpattern not - -t pattern. You may be able to get a big speedup by - running tests in parallel: try -j8. - - Usage: - - $ shelltestrunner [testrunneropts] executable testfile1 [testfile2 ...] - - Test file format: - - ; 0 or more comment lines beginning with ; - -opt1 -opt2 arg1 arg2 - <<< - 0 or more lines of input - >>> - 0 or more lines of expected output - >>>2 - 0 or more lines of expected error output - >>>= - expected numeric exit code - - Initial lines beginning with ; are ignored. The next line - is the command-line arguments which will be appended to - the executable name. All remaining fields are optional; - when omitted they are assumed to be "", "", "", and 0 - respectively. - - Issues: - - - on mac, will hang if executable does not read stdin - - output order is mixed up - - can't test input/ouput which does not end with newline - + . + Run a given program through "shell" tests specifed by one or more test + files, each of which can specify: command-line arguments, input, expected + output, expected stderr output, and expected exit code. This was + extracted from the hledger project, inspired by the tests in John + Wiegley's ledger project, and uses test-framework's test runner. + . + Usage: + . + > shelltestrunner [opts] executable testfile1 [testfile2 ...] [-- ] + . + You can pass options through to test-framework's runner; they must go + after -- at the end. You may be able to get a big speedup by running + tests in parallel: try -- -j8. + . + Test file format: + . + > # 0 or more comment lines beginning with # + > -opt1 -opt2 arg1 arg2 # command line args, executable will be prepended + > <<< + > 0 or more lines of input + > >>> [/regexp/] + > [..or 0 or more lines of expected output] + > >>>2 [/regexp/] + > [..or 0 or more lines of expected error output] + > >>>= [/regexp/] + > [..or expected numeric exit code] + . + The expected fields can also have a regular expression match expression + following the delimiter on the same line, with no other data lines, in + which case the test passes if the output is matched by the regexp. The + regexp is enclosed in forward slashess. A ! preceding the expression + negates the match. For example, to check that stdout does not contain + "axe": + . + > >>> !/axe/ + . + Apart from the command line, all fields are optional. Only fields + specified in the test will be tested, unless you use the + -i/--implicit-tests flag, which will test for empty stdout, empty stderr, + or 0 exit code whenever fields are omitted. + . + Issues: + . + - output order is mixed up + . + - option processing is weak + . + - can't test input/output which does not end with newline + . + Wishlist: + . + - configurable delimiters + . + - multiple tests per file + . license: GPL license-file: LICENSE author: Simon Michael @@ -70,3 +84,4 @@ ,test-framework ,test-framework-hunit >= 0.2 && < 0.3 ,parseargs >= 0.1 && < 0.2 + ,regexpr >= 0.5.1 diff --git a/shelltestrunner.hs b/shelltestrunner.hs --- a/shelltestrunner.hs +++ b/shelltestrunner.hs @@ -11,31 +11,35 @@ module Main where ---import Control.Concurrent (forkIO) +import Control.Concurrent (forkIO) +import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) import Control.Monad (liftM,when) import Data.List (partition) -import Data.Maybe (fromMaybe,fromJust) +import Data.Maybe (fromJust,isJust,maybe) import qualified Test.HUnit (Test) import System.Console.ParseArgs hiding (args) import System.Environment (withArgs) import System.Exit (ExitCode(..),exitWith) -import System.IO (hGetContents, hPutStr, stderr) +import System.IO (Handle, hGetContents, hPutStr, stderr) import System.Process (runInteractiveCommand, waitForProcess) --- import System.Process (createProcess, shell, CreateProcess(..), StdStream(..)) import Test.Framework (defaultMain) import Test.Framework.Providers.HUnit (hUnitTestToTests) import Test.HUnit hiding (Test) import Text.ParserCombinators.Parsec import Text.Printf (printf) +import Text.RegexPR import Debug.Trace strace :: Show a => a -> a strace a = trace (show a) a + version :: String -version = "0.3" -- sync with .cabal +version = "0.4" -- keep synced with .cabal data ArgId = HelpFlag | VersionFlag + | DebugFlag + | ImplicitTestsFlag | ExecutableArg deriving (Ord, Eq, Show) @@ -53,33 +57,56 @@ argData = Nothing, argDesc = "show version" } + ,Arg {argIndex = DebugFlag, + argName = Just "debug", + argAbbr = Just 'd', + argData = Nothing, + argDesc = "show verbose debugging output" + } + ,Arg {argIndex = ImplicitTestsFlag, + argName = Just "implicit-tests", + argAbbr = Just 'i', + argData = Nothing, + argDesc = "provide implicit tests for all omitted fields" + } ,Arg {argIndex = ExecutableArg, argName = Nothing, argAbbr = Nothing, argData = argDataRequired "executable" ArgtypeString, - argDesc = "executable program or shell command to test, should accept stdin" + argDesc = "executable program or shell command to test" } ] data ShellTest = ShellTest { - filename :: String - ,command :: String + testname :: String + ,commandargs :: String ,stdin :: Maybe String - ,stdoutExpected :: Maybe String - ,stderrExpected :: Maybe String - ,exitCodeExpected :: Maybe ExitCode + ,stdoutExpected :: Maybe Matcher + ,stderrExpected :: Maybe Matcher + ,exitCodeExpected :: Maybe Matcher } deriving (Show) +type Regex = String + +data Matcher = Exact String + | Numeric String + | PositiveRegex Regex + | NegativeRegex Regex + deriving (Show) + main :: IO () main = do - args <- parseArgsIO ArgsInterspersed argspec - -- parseargs issue: if there's no exe, exits at first gotArg - when (gotArg args VersionFlag) printVersion - when (gotArg args HelpFlag) $ printHelp args + args <- parseArgsIO ArgsTrailing argspec + -- parseargs issue: exits at first gotArg if there's no exe argument + when (args `gotArg` VersionFlag) printVersion + when (args `gotArg` HelpFlag) $ printHelp args let (unprocessedopts, testfiles) = partition ((=="-").take 1) $ argsRest args - exe = fromJust $ getArgString args ExecutableArg - shelltests <- mapM parseShellTest testfiles - withArgs unprocessedopts $ defaultMain $ concatMap (hUnitTestToTests.shellTestToHUnitTest exe) shelltests + when (args `gotArg` DebugFlag) $ do + putStrLn $ "testing executable: " ++ (show $ fromJust $ getArgString args ExecutableArg) + putStrLn $ "unprocessed options: " ++ show unprocessedopts + putStrLn $ "test files: " ++ show testfiles + shelltests <- mapM (parseShellTest args) testfiles + withArgs unprocessedopts $ defaultMain $ concatMap (hUnitTestToTests.shellTestToHUnitTest args) shelltests printVersion :: IO () printVersion = putStrLn version >> exitWith ExitSuccess @@ -87,82 +114,163 @@ printHelp :: Args ArgId -> IO () printHelp args = putStrLn (argsUsage args) >> exitWith ExitSuccess -shellTestToHUnitTest :: FilePath -> ShellTest -> Test.HUnit.Test -shellTestToHUnitTest exe t = filename t ~: do {r <- runShellTest exe t; assertBool "" r} +-- parsing -parseShellTest :: FilePath -> IO ShellTest -parseShellTest = liftM (either (error.show) id) . parseFromFile shelltest +parseShellTest :: Args ArgId -> FilePath -> IO ShellTest +parseShellTest args f = do + t <- liftM (either (error.show) id) $ parseFromFile shelltestp f + when (args `gotArg` DebugFlag) $ do + putStrLn $ "parsing file: " ++ f + putStrLn $ "parsed test: " ++ show t + return t -shelltest :: Parser ShellTest -shelltest = do +shelltestp :: Parser ShellTest +shelltestp = do st <- getParserState let f = sourceName $ statePos st - many commentline - c <- commandline - i <- optionMaybe input - o <- optionMaybe expectedoutput - e <- optionMaybe expectederror - x <- optionMaybe expectedexitcode - return ShellTest{filename=f,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} + many commentlinep + c <- commandargsp + i <- optionMaybe inputp + o <- optionMaybe expectedoutputp + e <- optionMaybe expectederrorp + x <- optionMaybe expectedexitcodep + return ShellTest{testname=f,commandargs=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} -line,commentline,commandline,delimiter,input,expectedoutput,expectederror :: Parser String +linep,commentlinep,commandargsp,delimiterp,inputp,whitespacep :: Parser String -line = anyChar `manyTill` newline +linep = anyChar `manyTill` newline -commentline = char ';' >> anyChar `manyTill` newline +commentlinep = char '#' >> anyChar `manyTill` newline --- noncommentline = do --- l <- line --- if take 1 (strip l) == ";" then line else return l +commandargsp = linep -commandline = line +delimiterp = choice [try $ string "<<<", try $ string ">>>", (eof >> return "")] -delimiter = choice [try $ string "<<<", try $ string ">>>", (eof >> return "")] +inputp = string "<<<\n" >> (liftM unlines) (linep `manyTill` (lookAhead delimiterp)) -input = string "<<<\n" >> (liftM unlines) (line `manyTill` (lookAhead delimiter)) +expectedoutputp :: Parser Matcher +expectedoutputp = try $ do + string ">>>" >> optional (char '1') + whitespacep + choice [positiveregexmatcherp, negativeregexmatcherp, datalinesp] -expectedoutput = try $ string ">>>" >> optional (char '1') >> newline >> (liftM unlines) (line `manyTill` (lookAhead delimiter)) +expectederrorp :: Parser Matcher +expectederrorp = try $ do + string ">>>2" + whitespacep + choice [positiveregexmatcherp, negativeregexmatcherp, datalinesp] -expectederror = try $ string ">>>2\n" >> (liftM unlines) (line `manyTill` (lookAhead delimiter)) +expectedexitcodep :: Parser Matcher +expectedexitcodep = do + string ">>>=" + whitespacep + choice [positiveregexmatcherp, negativeregexmatcherp, numericdatalinesp] -expectedexitcode :: Parser ExitCode -expectedexitcode = string ">>>=" >> (liftM (toExitCode.read.unlines) (line `manyTill` eof)) +negativeregexmatcherp :: Parser Matcher +negativeregexmatcherp = do + char '!' + PositiveRegex r <- positiveregexmatcherp + return $ NegativeRegex r -runShellTest :: FilePath -> ShellTest -> IO Bool -runShellTest exe ShellTest{ - filename=_,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} = do - let cmd = unwords [exe,c] - (i',o',e',x') = (fromMaybe "" i, fromMaybe "" o, fromMaybe "" e, fromMaybe ExitSuccess x) - -- printf "%s .. " f; hFlush stdout +positiveregexmatcherp :: Parser Matcher +positiveregexmatcherp = do + char '/' + r <- many $ noneOf "/" + char '/' + whitespacep + newline + return $ PositiveRegex r +datalinesp :: Parser Matcher +datalinesp = do + whitespacep + newline + (liftM $ Exact . unlines) (linep `manyTill` (lookAhead delimiterp)) + +numericdatalinesp :: Parser Matcher +numericdatalinesp = do + whitespacep + newline + whitespacep + s <- many1 $ oneOf "0123456789" + newline + return $ Numeric s + +whitespacep = many $ oneOf " \t" + +-- running + +shellTestToHUnitTest :: Args ArgId -> ShellTest -> Test.HUnit.Test +shellTestToHUnitTest args t = testname t ~: do {r <- runShellTest args t; assertBool "" r} + +runShellTest :: Args ArgId -> ShellTest -> IO Bool +runShellTest args ShellTest{testname=n,commandargs=c,stdin=i,stdoutExpected=o_expected, + stderrExpected=e_expected,exitCodeExpected=x_expected} = do + let exe = fromJust $ getArgString args ExecutableArg + cmd = unwords [exe,c] + (o_expected',e_expected',x_expected') = + case (args `gotArg` ImplicitTestsFlag) of + True -> (case o_expected of + Just m -> Just m + _ -> Just $ Exact "" + ,case e_expected of Just m -> Just m + _ -> Just $ Exact "" + ,case x_expected of Just m -> Just m + _ -> Just $ Numeric "0") + False -> (o_expected,e_expected,x_expected) + when (args `gotArg` DebugFlag) $ do + putStrLn $ "running test: " ++ n + putStrLn $ "running command: " ++ cmd + + -- run the command, passing it the stdin if any, and reading the + -- stdout/stderr/exit code. This has to be done carefully. (ih,oh,eh,ph) <- runInteractiveCommand cmd - -- forkIO $ hPutStr ih i' -- separate thread in case cmd does not read stdin - -- (Just ih,Just oh,Just eh,ph) <- createProcess $ (shell cmd){std_in=CreatePipe,std_out=CreatePipe,std_err=CreatePipe} - hPutStr ih i' - out <- hGetContents oh - err <- hGetContents eh - -- on a mac, this hangs if cmd does not read stdin (http://hackage.haskell.org/trac/ghc/ticket/3369) - exit <- waitForProcess ph + when (isJust i) $ forkIO (hPutStr ih $ fromJust i) >> return () + o <- newEmptyMVar + e <- newEmptyMVar + forkIO $ oh `hGetContentsStrictlyAnd` putMVar o + forkIO $ eh `hGetContentsStrictlyAnd` putMVar e + x_actual <- waitForProcess ph + o_actual <- takeMVar o + e_actual <- takeMVar e - let (outputok, errorok, exitok) = (out==o', err==e', exit==x') - if outputok && errorok && exitok + let o_ok = maybe True (o_actual `matches`) o_expected' + let e_ok = maybe True (e_actual `matches`) e_expected' + let x_ok = maybe True ((show $ fromExitCode x_actual) `matches`) x_expected' + if o_ok && e_ok && x_ok then do - -- putStrLn "ok" return True else do - -- hPutStr stderr $ printf "FAIL\n" - when (not outputok) $ printExpectedActual "stdout" o' out - when (not errorok) $ printExpectedActual "stderr" e' err - when (not exitok) $ printExpectedActual "exit code" (show (fromExitCode x')++"\n") (show (fromExitCode exit)++"\n") + when (not o_ok) $ printExpectedActual "stdout" (fromJust o_expected') o_actual + when (not e_ok) $ printExpectedActual "stderr" (fromJust e_expected') e_actual + when (not x_ok) $ printExpectedActual "exit code" (fromJust x_expected') (show $ fromExitCode x_actual) return False -printExpectedActual :: String -> String -> String -> IO () -printExpectedActual f e a = hPutStr stderr $ printf "**Expected %s:\n%s**Got %s:\n%s" f e f a +hGetContentsStrictlyAnd :: Handle -> (String -> IO b) -> IO b +hGetContentsStrictlyAnd h f = hGetContents h >>= \c -> length c `seq` f c -toExitCode :: Int -> ExitCode -toExitCode 0 = ExitSuccess -toExitCode n = ExitFailure n +matches :: String -> Matcher -> Bool +matches s (PositiveRegex r) = s `containsRegex` r +matches s (NegativeRegex r) = not $ s `containsRegex` r +matches s (Numeric p) = s == p +matches s (Exact p) = s == p +showMatcher :: Matcher -> String +showMatcher (PositiveRegex r) = " /"++r++"/\n" +showMatcher (NegativeRegex r) = " !/"++r++"/\n" +showMatcher (Numeric s) = "\n"++s +showMatcher (Exact s) = "\n"++s + +printExpectedActual :: String -> Matcher -> String -> IO () +printExpectedActual f e a = hPutStr stderr $ printf "**Expected %s:%s**Got %s:\n%s" f (showMatcher e) f a + + +-- utils + +-- toExitCode :: Int -> ExitCode +-- toExitCode 0 = ExitSuccess +-- toExitCode n = ExitFailure n + fromExitCode :: ExitCode -> Int fromExitCode ExitSuccess = 0 fromExitCode (ExitFailure n) = n @@ -172,3 +280,8 @@ lstrip = dropws rstrip = reverse . dropws . reverse dropws = dropWhile (`elem` " \t") + +containsRegex :: String -> String -> Bool +containsRegex s r = case matchRegexPR (""++r) s of + Just _ -> True + _ -> False