diff --git a/shelltestrunner.cabal b/shelltestrunner.cabal --- a/shelltestrunner.cabal +++ b/shelltestrunner.cabal @@ -1,69 +1,71 @@ name: shelltestrunner -version: 0.6 +version: 0.7 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, where each test can specify: command-line arguments, input, expected - output, expected stderr output, and/or 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. + Run a command-line program through \"shell tests\" defined in one or + more test files. Each test specifies command-line arguments, some input, + and expected output, stderr output and/or exit status. + We use test-framework's test runner, so can run tests in parallel. + shelltestrunner was inspired by the tests in John Wiegley's ledger project. . 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. + > shelltestrunner [FLAGS] EXECUTABLE [TESTFILES ...] + > + > -? --help[=FORMAT] Show usage information (optional format) + > -V --version Show version information + > -v --verbose Higher verbosity + > -q --quiet Lower verbosity + > -d --debug show debug messages + > --debug-parse show parsing debug messages and stop + > -i --implicit=none|exit|all provide implicit tests (default=exit) . - Test file format: + Any unrecognised options will be passed through to test-framework's runner. + You may be able to get a big speedup by running tests in parallel: try -j16. . - A test file contains 0 or more shell tests, each of which looks like this: + A test file contains one or more shell tests, each of which looks like this: . - > # 0 or more comment lines beginning with # + > # optional comment lines beginning with # > -opt1 -opt2 arg1 arg2 # one line of command line args, executable will be prepended > <<< > 0 or more lines of input - > >>> [/regexp/] + > >>> [/regexp/] [optional comment beginning with #] > [..or 0 or more lines of expected output] - > >>>2 [/regexp/] + > >>>2 [/regexp/] [optional comment] > [..or 0 or more lines of expected error output] - > >>>= [expected numeric exit code or /regexp/] - . - Each expected field can have either a regular expression match - expression, in which case the test passes if the output is matched, or 0 - or more data lines, in which case the output must match these exactly. A - ! preceding a \/regexp\/ negates the match. The regular expression syntax - is that supported by the regexpr library. - . - Apart from the command line, all fields are optional. Only the fields you - specify will be tested, unless you use the -i/--implicit-tests flag, - which adds default tests (empty stdout, empty stderr, and 0 exit code) - for omitted fields. - . - Issues: + > >>>= [expected exit status or /regexp/] [optional comment] + > # optional comment lines . - - can't test input/output which does not end with newline + The expected output and expected error output fields can have either a + regular expression match expression, in which case the test passes if the + output is matched, or 0 or more following data lines, in which case the + output must match these exactly. The expected exit status field can have + either a numeric exit code or a regular expression match expression. A ! + preceding a an exit code or \/regexp\/ negates the match. The regular + expression syntax is that of the pcre-light library with the dotall flag. . - - can't use / in regexps + The command line args field is required, all others are optional. By + default there is an implicit test for exit status = 0, but no implicit + test for stdout or stderr. You can change this with the + -i/--implicit-tests flag. . - - option processing and --help output could be better + Some issues to be aware of: . - Wishlist: + - uncompiled haskell scripts can't be tested due to http://hackage.haskell.org/trac/ghc/ticket/3890 . - - configurable delimiters + - unparseable test files and uncompilable regexps are counted as test failures . license: GPL license-file: LICENSE author: Simon Michael maintainer: Simon Michael homepage: http://joyful.com/darcsweb/darcsweb.cgi?r=shelltestrunner --- bug-reports: -stability: experimental +bug-reports: mailto:simon@joyful.com +stability: beta tested-with: GHC==6.10 -cabal-version: >= 1.2 +cabal-version: >= 1.6 build-type: Simple extra-tmp-files: @@ -78,6 +80,10 @@ ,process ,HUnit ,test-framework - ,test-framework-hunit >= 0.2 && < 0.3 - ,parseargs >= 0.1 && < 0.2 - ,regexpr >= 0.5.1 + ,test-framework-hunit >= 0.2 + ,cmdargs >= 0.1 + ,pcre-light >= 0.3.1 + +source-repository head + type: darcs + location: http://joyful.com/repos/hledger diff --git a/shelltestrunner.hs b/shelltestrunner.hs --- a/shelltestrunner.hs +++ b/shelltestrunner.hs @@ -1,7 +1,8 @@ #!/usr/bin/env runhaskell +{-# LANGUAGE DeriveDataTypeable #-} {- -shelltestrunner - a handy tool for testing command-line programs. +shelltestrunner - a tool for testing command-line programs. See shelltestrunner.cabal. @@ -13,70 +14,64 @@ where import Control.Concurrent (forkIO) import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) -import Control.Monad (liftM,when) -import Data.List (partition, intercalate) -import Data.Maybe (fromJust,isJust,maybe,isNothing,catMaybes) +import Control.Monad (liftM,when,unless) +import Data.List (intercalate) +import Data.Maybe (isNothing,isJust,fromJust,maybe,catMaybes) import qualified Test.HUnit (Test) -import System.Console.ParseArgs hiding (args) -import System.Environment (withArgs) -import System.Exit (ExitCode(..),exitWith) +import System.Console.CmdArgs hiding (args) +import qualified System.Console.CmdArgs as CmdArgs (args) +import System.Exit (ExitCode(..), exitWith) import System.IO (Handle, hGetContents, hPutStr) import System.Process (runInteractiveCommand, waitForProcess) -import Test.Framework (defaultMain) +import Test.Framework (defaultMainWithArgs) import Test.Framework.Providers.HUnit (hUnitTestToTests) import Test.HUnit hiding (Test) import Text.ParserCombinators.Parsec import Text.Printf (printf) -import Text.RegexPR +import Text.Regex.PCRE.Light.Char8 import Debug.Trace strace :: Show a => a -> a strace a = trace (show a) a -version :: String -version = "0.6" -- keep synced with .cabal +version = "0.6.98" -- keep synced with shelltestrunner.cabal +progname = "shelltestrunner" +progversion = progname ++ " " ++ version +version, progname, progversion :: String -data ArgId = HelpFlag - | VersionFlag - | DebugFlag - | ImplicitTestsFlag - | ExecutableArg - deriving (Ord, Eq, Show) +data Args = Args { + debug :: Bool + ,debugparse :: Bool + ,implicit :: String + ,executable :: String + ,testfiles :: [String] + ,otheropts :: [String] + } deriving (Show, Data, Typeable) -argspec :: [Arg ArgId] -argspec = [ - Arg {argIndex = HelpFlag, - argName = Just "help", - argAbbr = Just 'h', - argData = Nothing, - argDesc = "show help" - } - ,Arg {argIndex = VersionFlag, - argName = Just "version", - argAbbr = Just 'V', - 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" - } +nullargs :: Args +nullargs = Args False False "" "" [] [] + +argmodes :: [Mode Args] +argmodes = [ + mode $ Args{ + debug = def &= flag "debug" & text "show debug messages" + ,debugparse = def &= flag "debug-parse" & explicit & text "show parsing debug messages and stop" + ,implicit = "exit" &= typ "none|exit|all" & text "provide implicit tests" + ,executable = def &= argPos 0 & typ "EXECUTABLE" & text "executable under test" + ,testfiles = def &= CmdArgs.args & typ "TESTFILES" & text "test files" + ,otheropts = def &= unknownFlags & explicit & typ "FLAGS" & text "other flags are passed to test runner" + } ] +checkArgs :: Args -> IO Args +checkArgs args = do + when (not $ i `elem` ["none","exit","all"]) $ + warn $ printf "Bad -i/--implicit value %s, valid choices are: none, exit or all" $ show i + return args + where + i = implicit args + warn s = cmdArgsHelp s argmodes Text >>= putStrLn >> exitWith (ExitFailure 1) + data ShellTest = ShellTest { testname :: String ,commandargs :: String @@ -84,146 +79,189 @@ ,stdoutExpected :: Maybe Matcher ,stderrExpected :: Maybe Matcher ,exitCodeExpected :: Maybe Matcher - } deriving (Show) + } -type Regex = String +type Regexp = String data Matcher = Lines String | Numeric String - | PositiveRegex Regex - | NegativeRegex Regex - deriving (Show) + | NegativeNumeric String + | PositiveRegex Regexp + | NegativeRegex Regexp main :: IO () main = do - 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 - when (args `gotArg` DebugFlag) $ do - putStrLn $ "testing executable: " ++ (show $ fromJust $ getArgString args ExecutableArg) - putStrLn $ "unprocessed options: " ++ show unprocessedopts - putStrLn $ "test files: " ++ show testfiles - shelltests <- liftM concat $ mapM (parseShellTestFile args) testfiles - withArgs unprocessedopts $ defaultMain $ concatMap (hUnitTestToTests.shellTestToHUnitTest args) shelltests - -printVersion :: IO () -printVersion = putStrLn version >> exitWith ExitSuccess - -printHelp :: Args ArgId -> IO () -printHelp args = putStrLn (argsUsage args) >> exitWith ExitSuccess + args <- cmdArgs progversion argmodes >>= checkArgs + when (debug args) $ printf "args: %s\n" (show args) + loud <- isLoud + when loud $ do + printf "executable: %s\n" (executable args) + printf "test files: %s\n" (intercalate ", " $ testfiles args) + parseresults <- mapM (parseShellTestFile args) $ testfiles args + unless (debugparse args) $ + defaultMainWithArgs (concatMap (hUnitTestToTests.testFileParseToHUnitTest args) parseresults) (otheropts args) -- parsing -parseShellTestFile :: Args ArgId -> FilePath -> IO [ShellTest] +parseShellTestFile :: Args -> FilePath -> IO (Either ParseError [ShellTest]) parseShellTestFile args f = do - when (args `gotArg` DebugFlag) $ putStrLn $ "parsing file: " ++ f - ts <- liftM (either (error.show) id) $ parseFromFile (many shelltestp) f - let ts' | length ts > 1 = [t{testname=testname t++":"++show n} | (n,t) <- zip ([1..]::[Int]) ts] - | otherwise = ts - when (args `gotArg` DebugFlag) $ putStrLn $ "parsed tests: " ++ show ts' - return ts' + p <- parseFromFile shelltestfilep f + case p of + Right ts -> do + let ts' | length ts > 1 = [t{testname=testname t++":"++show n} | (n,t) <- zip ([1..]::[Int]) ts] + | otherwise = ts + when (debug args || debugparse args) $ do + printf "parsed %s:\n" f + mapM_ (putStrLn.(' ':).show) ts' + return $ Right ts' + Left _ -> return p +shelltestfilep :: Parser [ShellTest] +shelltestfilep = do + ts <- many (try shelltestp) + many commentlinep + eof + return ts + shelltestp :: Parser ShellTest shelltestp = do st <- getParserState let f = sourceName $ statePos st many commentlinep - c <- commandargsp - i <- optionMaybe inputp - o <- optionMaybe expectedoutputp - e <- optionMaybe expectederrorp - x <- optionMaybe expectedexitcodep - when (null c && (isNothing i) && (null $ catMaybes [o,e,x])) $ fail "empty test file" - return ShellTest{testname=f,commandargs=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} - -linep,commentlinep,commandargsp,delimiterp,inputp,whitespacep :: Parser String - -linep = anyChar `manyTill` newline + c <- commandargsp "command arguments" + i <- optionMaybe inputp "input" + o <- optionMaybe expectedoutputp "expected output" + e <- optionMaybe expectederrorp "expected error output" + x <- optionMaybe expectedexitcodep "expected exit status" + when (null c && (isNothing i) && (null $ catMaybes [o,e,x])) $ fail "" + return $ ShellTest{testname=f,commandargs=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} -commentlinep = char '#' >> anyChar `manyTill` newline +newlineoreofp, whitespacecharp :: Parser Char +linep,lineoreofp,whitespacep,whitespacelinep,commentlinep,whitespaceorcommentlinep,whitespaceorcommentlineoreofp,commandargsp,delimiterp,inputp :: Parser String +linep = (anyChar `manyTill` newline) "rest of line" +newlineoreofp = newline <|> (eof >> return '\n') "newline or end of file" +lineoreofp = (anyChar `manyTill` newlineoreofp) +whitespacecharp = oneOf " \t" +whitespacep = many whitespacecharp +whitespacelinep = try (newline >> return "") <|> (whitespacecharp >> whitespacecharp `manyTill` newlineoreofp) +commentlinep = whitespacep >> char '#' >> lineoreofp "comments" +whitespaceorcommentlinep = choice [try commentlinep, whitespacelinep] +whitespaceorcommentlineoreofp = choice [(eof >> return ""), try commentlinep, whitespacelinep] +delimiterp = choice [try $ string "<<<", try $ string ">>>", try commentlinep >> return "", eof >> return ""] commandargsp = linep -delimiterp = choice [try $ string "<<<", try $ string ">>>", (eof >> return "")] - -inputp = string "<<<" >> newline >> (liftM unlines) (linep `manyTill` (lookAhead delimiterp)) +inputp = string "<<<" >> whitespaceorcommentlinep >> (liftM unlines) (linep `manyTill` (lookAhead delimiterp)) expectedoutputp :: Parser Matcher -expectedoutputp = try $ do +expectedoutputp = (try $ do string ">>>" >> optional (char '1') whitespacep - choice [positiveregexmatcherp, negativeregexmatcherp, linesmatcherp] + choice [positiveregexmatcherp, negativeregexmatcherp, whitespaceorcommentlineoreofp >> linesmatcherp] + ) "expected output" expectederrorp :: Parser Matcher -expectederrorp = try $ do +expectederrorp = (try $ do string ">>>2" whitespacep - choice [positiveregexmatcherp, negativeregexmatcherp, linesmatcherp] + choice [positiveregexmatcherp, negativeregexmatcherp, (whitespaceorcommentlineoreofp >> linesmatcherp)] + ) "expected error output" expectedexitcodep :: Parser Matcher -expectedexitcodep = do +expectedexitcodep = (try $ do string ">>>=" whitespacep - choice [positiveregexmatcherp, negativeregexmatcherp, numericmatcherp] + choice [positiveregexmatcherp, try negativeregexmatcherp, numericmatcherp, negativenumericmatcherp] + ) "expected exit status" +linesmatcherp :: Parser Matcher +linesmatcherp = do + (liftM $ Lines . unlines) (linep `manyTill` (lookAhead delimiterp)) "lines of output" + negativeregexmatcherp :: Parser Matcher -negativeregexmatcherp = do +negativeregexmatcherp = (do char '!' PositiveRegex r <- positiveregexmatcherp - return $ NegativeRegex r + return $ NegativeRegex r) "non-matched regexp pattern" positiveregexmatcherp :: Parser Matcher -positiveregexmatcherp = do - char '/' - r <- many $ noneOf "/" +positiveregexmatcherp = (do char '/' - whitespacep - newline - return $ PositiveRegex r + r <- (try escapedslashp <|> noneOf "/") `manyTill` (char '/') + whitespaceorcommentlineoreofp + return $ PositiveRegex r) "regexp pattern" -linesmatcherp :: Parser Matcher -linesmatcherp = do - whitespacep - newline - (liftM $ Lines . unlines) (linep `manyTill` (lookAhead delimiterp)) +negativenumericmatcherp :: Parser Matcher +negativenumericmatcherp = (do + char '!' + Numeric s <- numericmatcherp + return $ NegativeNumeric s + ) "non-matched number" numericmatcherp :: Parser Matcher -numericmatcherp = do +numericmatcherp = (do s <- many1 $ oneOf "0123456789" - whitespacep - newline + whitespaceorcommentlineoreofp return $ Numeric s + ) "number" -whitespacep = many $ oneOf " \t" +escapedslashp :: Parser Char +escapedslashp = char '\\' >> char '/' -- running -shellTestToHUnitTest :: Args ArgId -> ShellTest -> Test.HUnit.Test +testFileParseToHUnitTest :: Args -> Either ParseError [ShellTest] -> Test.HUnit.Test +testFileParseToHUnitTest args (Right ts) = TestList $ map (shellTestToHUnitTest args) ts +testFileParseToHUnitTest _ (Left e) = ("parse error in " ++ (sourceName $ errorPos e)) ~: assertFailure $ show e + +shellTestToHUnitTest :: Args -> ShellTest -> Test.HUnit.Test shellTestToHUnitTest args ShellTest{testname=n,commandargs=c,stdin=i,stdoutExpected=o_expected, stderrExpected=e_expected,exitCodeExpected=x_expected} = n ~: do - let exe = fromJust $ getArgString args ExecutableArg + let exe = executable args 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 $ Lines "" - ,case e_expected of Just m -> Just m - _ -> Just $ Lines "" - ,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 + case (implicit args) of + "all" -> (case o_expected of + Just m -> Just m + _ -> Just $ Lines "" + ,case e_expected of Just m -> Just m + _ -> Just $ Lines "" + ,case x_expected of Just m -> Just m + _ -> Just $ Numeric "0") + "exit" -> (o_expected,e_expected + ,case x_expected of Just m -> Just m + _ -> Just $ Numeric "0") + _ -> (o_expected,e_expected,x_expected) + when (debug args) $ printf "command: %s\n" (show cmd) + (o_actual, e_actual, x_actual) <- runCommandWithInput cmd i + when (debug args) $ do + printf "stdout: %s\n" (show $ trim o_actual) + printf "stderr: %s\n" (show $ trim e_actual) + printf "exit: %s\n" (show $ trim $ show x_actual) + if (x_actual == 127) -- catch bad executable - should work on posix systems at least + then ioError $ userError e_actual -- XXX still a test failure; should be an error + else assertString $ addnewline $ intercalate "\n" $ filter (not . null) [ + if (maybe True (o_actual `matches`) o_expected') + then "" + else showExpectedActual "stdout" (fromJust o_expected') o_actual + ,if (maybe True (e_actual `matches`) e_expected') + then "" + else showExpectedActual "stderr" (fromJust e_expected') e_actual + ,if (maybe True (show x_actual `matches`) x_expected') + then "" + else showExpectedActual "exit code" (fromJust x_expected') (show x_actual) + ] + where addnewline "" = "" + addnewline s = "\n"++s - -- run the command, passing it the stdin if any, and reading the - -- stdout/stderr/exit code. This has to be done carefully. +-- | Run a shell command line, passing it standard input if provided, +-- and return the standard output, standard error output and exit code. +runCommandWithInput :: String -> Maybe String -> IO (String, String, Int) +runCommandWithInput cmd input = do + -- this has to be done carefully (ih,oh,eh,ph) <- runInteractiveCommand cmd - when (isJust i) $ forkIO (hPutStr ih $ fromJust i) >> return () + when (isJust input) $ forkIO (hPutStr ih $ fromJust input) >> return () o <- newEmptyMVar e <- newEmptyMVar forkIO $ oh `hGetContentsStrictlyAnd` putMVar o @@ -231,49 +269,50 @@ x_actual <- waitForProcess ph >>= return.fromExitCode o_actual <- takeMVar o e_actual <- takeMVar e - - let failuremsg - -- when a bad exe is provided, we don't want to show all the test - -- failures. This should work on all posix systems at least. - -- Really we should report a test error here, not a failure. - | x_actual == 127 = cmd ++ ": command not found" - | otherwise = addnewline $ intercalate "\n" $ filter (not . null) [ - if (maybe True (o_actual `matches`) o_expected') - then "" - else showExpectedActual "stdout" (fromJust o_expected') o_actual - ,if (maybe True (e_actual `matches`) e_expected') - then "" - else showExpectedActual "stderr" (fromJust e_expected') e_actual - ,if (maybe True (show x_actual `matches`) x_expected') - then "" - else showExpectedActual "exit code" (fromJust x_expected') (show x_actual) - ] - assertString failuremsg - where addnewline "" = "" - addnewline s = "\n"++s + return (o_actual, e_actual, x_actual) hGetContentsStrictlyAnd :: Handle -> (String -> IO b) -> IO b -hGetContentsStrictlyAnd h f = hGetContents h >>= \c -> length c `seq` f c +hGetContentsStrictlyAnd h f = hGetContents h >>= \s -> length s `seq` f s 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 (Lines p) = s == p +matches s (PositiveRegex r) = s `containsRegex` r +matches s (NegativeRegex r) = not $ s `containsRegex` r +matches s (Numeric p) = s == p +matches s (NegativeNumeric p) = not $ s == p +matches s (Lines p) = s == p showExpectedActual :: String -> Matcher -> String -> String showExpectedActual field e a = - printf "**Expected %s:%s**Got %s:\n%s" field (showMatcher e) field a + printf "**Expected %s: %s\n**Got %s: %s" field (show e) field (show $ trim a) -showMatcher :: Matcher -> String -showMatcher (PositiveRegex r) = " /"++r++"/\n" -showMatcher (NegativeRegex r) = " !/"++r++"/\n" -showMatcher (Numeric s) = "\n"++s++"\n" -showMatcher (Lines s) = "\n"++s +instance Show Matcher where + show (PositiveRegex r) = "/"++(trim r)++"/" + show (NegativeRegex r) = "!/"++(trim r)++"/" + show (Numeric s) = show $ trim s + show (NegativeNumeric s) = "!"++ show (trim s) + show (Lines s) = show $ trim s +instance Show ShellTest where + show ShellTest{testname=n,commandargs=a,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} = + printf "ShellTest {testname = %s, commandargs = %s, stdin = %s, stdoutExpected = %s, stderrExpected = %s, exitCodeExpected = %s}" + (show $ trim n) + (show $ trim a) + (maybe "Nothing" (show.trim) i) + (show o) + (show e) + (show x) + -- utils +trim :: String -> String +trim s | l <= limit = s + | otherwise = take limit s ++ suffix + where + limit = 500 + l = length s + suffix = printf "...(%d more)" (l-limit) + -- toExitCode :: Int -> ExitCode -- toExitCode 0 = ExitSuccess -- toExitCode n = ExitFailure n @@ -288,7 +327,13 @@ rstrip = reverse . dropws . reverse dropws = dropWhile (`elem` " \t") +-- | Does string contain this regular expression ? +-- A malformed regexp will cause a runtime error. containsRegex :: String -> String -> Bool -containsRegex s r = case matchRegexPR (""++r) s of - Just _ -> True - _ -> False +containsRegex s r = + case compileM r [ + dotall + -- ,utf8 -- shows no obvious benefit with 6.10, review situation with 6.12 + ] of + Right regex -> isJust $ match regex s [] + Left e -> error $ printf "bad regexp, %s: %s" e (trim $ r)