shelltestrunner 0.9 → 1.0
raw patch · 2 files changed
+141/−205 lines, 2 filesdep +Diffdep ~FileManipCompatdep ~basedep ~cmdargs
Dependencies added: Diff
Dependency ranges changed: FileManipCompat, base, cmdargs, directory, filepath, test-framework
Files
- shelltest.hs +126/−133
- shelltestrunner.cabal +15/−72
shelltest.hs view
@@ -6,27 +6,28 @@ See shelltestrunner.cabal. -(c) Simon Michael 2009-2010, released under GNU GPLv3--We try to handle non-ascii content in test file paths, test commands, and-expected test results. For this we assume:-- ghc 6.12-- on unix, all file names, arguments, environment variables etc. are utf-8 encoded+(c) Simon Michael 2009-2011, released under GNU GPLv3 or later. -} module Main where+-- encoding: we try to handle non-ascii content in test file paths, test+-- commands, and expected test results. For this we assume 1. ghc 6.12++-- and 2. that on unix, all file names/arguments/environment variables are+-- utf8 encoded import Codec.Binary.UTF8.String as UTF8 (decodeString, encodeString, isUTF8Encoded) import Control.Concurrent (forkIO) import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) import Control.Monad (liftM,when,unless)-import Data.List (intercalate, nub, isPrefixOf)+import Data.List import Data.Maybe (isNothing,isJust,fromJust,catMaybes) import qualified Test.HUnit (Test)-import System.Console.CmdArgs hiding (args)-import qualified System.Console.CmdArgs as CmdArgs (args)-import System.Exit (ExitCode(..), exitWith)+-- cmdargs: the impure method of writing annotations is susceptible to+-- over-optimisation by GHC - sometimes {-# OPTIONS_GHC -fno-cse #-} will be+-- required.+import System.Console.CmdArgs+import System.Exit import System.Info (os) import System.IO (Handle, hGetContents, hPutStr) import System.Process (StdStream (CreatePipe), shell, createProcess, CreateProcess (..), waitForProcess, ProcessHandle)@@ -42,92 +43,67 @@ import System.FilePath.FindCompat (findWithHandler, (==?), always) import qualified System.FilePath.FindCompat as Find (extension) import Control.Applicative ((<$>))+import Data.Algorithm.Diff+ strace :: Show a => a -> a strace a = trace (show a) a --version = "0.9" -- keep synced with cabal file+version, progname, progversion :: String+version = "1.0" -- keep synced with shelltestrunner.cabal progname = "shelltest" progversion = progname ++ " " ++ version-version, progname, progversion :: String--data Args = Args {- debug :: Bool- ,debugparse :: Bool- ,color :: Bool- ,execdir :: Bool- ,extension :: String- ,implicit :: String- ,with :: String- ,testpaths :: [FilePath]- ,otheropts :: [String]- } deriving (Show, Data, Typeable)---nullargs :: Args-nullargs = Args False False False False "" "" "" [] []--argmodes :: [Mode Args]-argmodes = [- mode (Args{- debug = def &= text "show debug messages"- ,debugparse = def &= flag "debug-parse" & explicit & text "show parsing debug messages and stop"- ,color = def &= text "display with ANSI color codes"- ,execdir = def &= text "run tests in same directory as test file"- ,extension = ".test" &= typ "EXT" & text "extension of test files when dirs specified"- ,implicit = "exit" &= typ "none|exit|all" & text "provide implicit tests"- ,with = def &= typ "EXECUTABLE" & text "alternate executable, replaces the first word of test commands"- ,testpaths = def &= CmdArgs.args & typ "TESTFILES|TESTDIRS" & text "test files or directories"- ,otheropts = def &= unknownFlags & explicit & typ "OTHER FLAGS" & text "any other flags are passed to test runner"- }) &= helpSuffix [- "A test file contains one or more shell tests, which look like this:"- ,""- ," # optional comment lines"- ," a one-line shell command to be tested"- ," <<<"- ," stdin lines"- ," >>> [/regexp to match in stdout/]"- ," [or expected stdout lines"- ," >>>2 [/regexp to match in stderr/]"- ," [or expected stderr lines]"- ," >>>= expected exit status or /regexp/"- ,""- ,"The command line is required; all other fields are optional."- ,"The expected stdout (>>>) and expected stderr (>>>2) fields can have either"- ,"a regular expression match pattern, 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. The expected exit status (>>>=) field can have"- ,"either a numeric exit code or a /regexp/. A ! preceding a /regexp/ or exit"- ,"code negates the match."+proghelpsuffix :: [String]+proghelpsuffix = [+ -- keep this bit synced with options width+ " -- TFOPTIONS Set extra test-framework options like -j/--threads,"+ ," -t/--select-tests, -o/--timeout (use -- --help for"+ ," a list.) Avoid spaces." ,""- ,"By default there is an implicit test for exit status=0, but no implicit test"- ,"for stdout or stderr. You can change this with -i/--implicit-tests."+ ]+formathelp :: String+formathelp = unlines [+ "Test format:" ,""- ,"The command runs in your current directory unless you use --execdir."- ,"You can use --with/-w to replace the first word of command lines"- ,"(everything up to the first space) with something else, eg to test a"- ,"different version of your program. To prevent this, start the command line"- ,"with a space."+ ,"# optional comments"+ ,"one-line shell command (required; indent to disable --with substitution)"+ ,"<<<"+ ,"0 or more lines of stdin input"+ ,">>>"+ ,"0 or more lines of expected stdout output (or /regexp/ on the previous line)"+ ,">>>2"+ ,"0 or more lines of expected stderr output (or /regexp/ on the previous line)"+ ,">>>= 0 (or other expected numeric exit status, or /regexp/) (required)" ,""- ,"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 -j8." ]- ] -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- when (null ps) $- warn $ printf "Please specify at least one file or directory, eg: %s ." progname- return args- where- i = implicit args- ps = testpaths args+data Args = Args {+ color :: Bool+ ,diff :: Bool+ ,exclude :: [String]+ ,execdir :: Bool+ ,extension :: String+ ,with :: String+ ,debug :: Bool+ ,debug_parse :: Bool+ ,help_format :: Bool+ ,testpaths :: [FilePath]+ } deriving (Show, Data, Typeable) --- | Show a message, usage string, and terminate with exit status 1.-warn :: String -> IO ()-warn s = cmdArgsHelp s argmodes Text >>= putStrLn >> exitWith (ExitFailure 1)+argdefs = Args {+ color = def &= help "Show colored output if your terminal supports it"+ ,diff = def &= name "d" &= help "Show diff of expected vs. actual when tests fail"+ ,exclude = def &= name "x" &= typ "STR" &= help "Exclude test files whose path contains STR"+ ,execdir = def &= help "Run tests from within the test file's directory"+ ,extension = ".test" &= typ "EXT" &= help "Filename suffix of test files (default: .test)"+ ,with = def &= typ "EXECUTABLE" &= help "Replace the first word of (unindented) test commands"+ ,debug = def &= help "Show debug info, for troubleshooting"+ ,debug_parse = def &= help "Show test file parsing info and stop"+ ,help_format = def &= help "Display test format help"+ ,testpaths = def &= args &= typ "TESTFILES|TESTDIRS"+ }+ &= program progname+ &= summary progversion+ &= details proghelpsuffix data ShellTest = ShellTest { testname :: String@@ -135,7 +111,7 @@ ,stdin :: Maybe String ,stdoutExpected :: Maybe Matcher ,stderrExpected :: Maybe Matcher- ,exitCodeExpected :: Maybe Matcher+ ,exitCodeExpected :: Matcher } data TestCommand = ReplaceableCommand String@@ -144,7 +120,7 @@ type Regexp = String -data Matcher = Lines String+data Matcher = Lines Int String | Numeric String | NegativeNumeric String | PositiveRegex Regexp@@ -152,22 +128,37 @@ main :: IO () main = do- args <- cmdArgs progversion argmodes >>= checkArgs- when (debug args) $ printf "args: %s\n" (show args)+ args' <- cmdArgs argdefs >>= checkArgs+ let (args,passthroughopts) = (args'{testpaths=realargs}, ptopts)+ where (ptopts,realargs) = partition ("-" `isPrefixOf`) $ testpaths args'+ when (debug args) $ printf "%s\n" progversion >> printf "args: %s\n" (show args) let paths = testpaths args- testfiles <- nub . concat <$> mapM (\p -> do+ testfiles' <- nub . concat <$> mapM (\p -> do isdir <- doesDirectoryExist p if isdir then findWithHandler (\_ e->fail (show e)) always (Find.extension ==? extension args) p else return [p]) paths- verbose <- isLoud- when verbose $ do- printf "executable: %s\n" (fromPlatformString $ with args)- printf "test files: %s\n" (intercalate ", " $ map fromPlatformString $ testfiles)+ let testfiles = filter (not . \p -> any (`isInfixOf` p) (exclude args)) testfiles'+ excluded = length testfiles' - length testfiles+ when (excluded > 0) $ printf "Excluding %d test files\n" excluded+ when (debug args) $ printf "processing %d test files: %s\n" (length testfiles) (intercalate ", " $ map fromPlatformString $ testfiles) parseresults <- mapM (parseShellTestFile args) testfiles- unless (debugparse args) $- defaultMainWithArgs (concatMap (hUnitTestToTests.testFileParseToHUnitTest args) parseresults) (otheropts args ++ if color args then [] else ["--plain"])+ unless (debug_parse args) $ defaultMainWithArgs+ (concatMap (hUnitTestToTests.testFileParseToHUnitTest args) parseresults)+ (passthroughopts ++ if color args then [] else ["--plain"]) +-- | Additional argument checking.+checkArgs :: Args -> IO Args+checkArgs args = do+ when (help_format args) $ printf formathelp >> exitSuccess+ when (null $ testpaths args) $+ warn $ printf "Please specify at least one test file or directory, eg: %s tests" progname+ return args++-- | Show a message, usage string, and terminate with exit status 1.+warn :: String -> IO ()+warn s = putStrLn s >> exitWith (ExitFailure 1)+ -- parsing parseShellTestFile :: Args -> FilePath -> IO (Either ParseError [ShellTest])@@ -177,16 +168,19 @@ 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+ when (debug args || debug_parse args) $ do printf "parsed %s:\n" $ fromPlatformString f mapM_ (putStrLn.(' ':).show) ts' return $ Right ts'- Left _ -> return p+ Left _ -> do+ when (debug args || debug_parse args) $ do+ printf "failed to parse any tests in %s\n" $ fromPlatformString f+ return p shelltestfilep :: Parser [ShellTest] shelltestfilep = do ts <- many (try shelltestp)- many commentlinep+ skipMany whitespaceorcommentlinep eof return ts @@ -194,13 +188,13 @@ shelltestp = do st <- getParserState let f = fromPlatformString $ sourceName $ statePos st- many $ try commentlinep+ skipMany whitespaceorcommentlinep c <- commandp <?> "command line" i <- optionMaybe inputp <?> "input" o <- optionMaybe expectedoutputp <?> "expected output" e <- optionMaybe expectederrorp <?> "expected error output"- x <- optionMaybe expectedexitcodep <?> "expected exit status"- when (null (show c) && (isNothing i) && (null $ catMaybes [o,e,x])) $ fail ""+ x <- expectedexitcodep <?> "expected exit status"+ when (null (show c) && (isNothing i) && (null $ catMaybes [o,e]) && null (show x)) $ fail "" return $ ShellTest{testname=f,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} newlineoreofp, whitespacecharp :: Parser Char@@ -210,18 +204,18 @@ 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 ""]+whitespacelinep = try (newline >> return "") <|> try (whitespacecharp >> whitespacecharp `manyTill` newlineoreofp)+commentlinep = try (whitespacep >> char '#' >> lineoreofp) <?> "comments"+whitespaceorcommentlinep = commentlinep <|> whitespacelinep+whitespaceorcommentlineoreofp = choice [(eof >> return ""), commentlinep, whitespacelinep]+delimiterp = choice [try $ string "<<<", try $ string ">>>", eof >> return ""] commandp,fixedcommandp,replaceablecommandp :: Parser TestCommand commandp = fixedcommandp <|> replaceablecommandp-fixedcommandp = space >> linep >>= return . FixedCommand+fixedcommandp = many1 whitespacecharp >> linep >>= return . FixedCommand replaceablecommandp = linep >>= return . ReplaceableCommand -inputp = string "<<<" >> whitespaceorcommentlinep >> (liftM unlines) (linep `manyTill` (lookAhead delimiterp))+inputp = try $ string "<<<" >> whitespaceorcommentlinep >> (liftM unlines) (linep `manyTill` (lookAhead delimiterp)) expectedoutputp :: Parser Matcher expectedoutputp = (try $ do@@ -246,7 +240,8 @@ linesmatcherp :: Parser Matcher linesmatcherp = do- (liftM $ Lines . unlines) (linep `manyTill` (lookAhead delimiterp)) <?> "lines of output"+ ln <- liftM sourceLine getPosition+ (liftM $ Lines ln . unlines) (linep `manyTill` (lookAhead delimiterp)) <?> "lines of output" negativeregexmatcherp :: Parser Matcher negativeregexmatcherp = (do@@ -292,19 +287,6 @@ cmd = case (e,c) of (_:_, ReplaceableCommand s) -> e ++ " " ++ dropWhile (/=' ') s (_, ReplaceableCommand s) -> s (_, FixedCommand s) -> s- (o_expected',e_expected',x_expected') =- 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) dir = if execdir args then Just $ takeDirectory n else Nothing when (debug args) $ printf "command was: %s\n" (show cmd) (o_actual, e_actual, x_actual) <- runCommandWithInput dir (toPlatformString cmd) i@@ -315,15 +297,15 @@ 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')+ 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')+ else showExpectedActual (diff args) "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')+ else showExpectedActual (diff args) "stderr" (fromJust e_expected) e_actual+ ,if (show x_actual `matches` x_expected) then ""- else showExpectedActual "exit code" (fromJust x_expected') (show x_actual)+ else showExpectedActual False "exit code" x_expected (show x_actual) ] where addnewline "" = "" addnewline s = "\n"++s@@ -363,18 +345,29 @@ 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+matches s (Lines _ p) = s == p -showExpectedActual :: String -> Matcher -> String -> String-showExpectedActual field e a =+showExpectedActual :: Bool -> String -> Matcher -> String -> String+showExpectedActual True _ (Lines ln e) a =+ printf "--- Expected\n+++ Got\n" ++ showDiff (1,ln) (getDiff (lines a) (lines e))+showExpectedActual _ field e a = printf "**Expected %s: %s\n**Got %s: %s" field (show e) field (show $ trim a) +showDiff :: (Int,Int) -> [(DI, String)] -> String+showDiff _ [] = ""+showDiff (l,r) ((F, ln) : ds) =+ printf "+%4d " l ++ ln ++ "\n" ++ showDiff (l+1,r) ds+showDiff (l,r) ((S, ln) : ds) =+ printf "-%4d " r ++ ln ++ "\n" ++ showDiff (l,r+1) ds+showDiff (l,r) ((B, _ ) : ds) =+ showDiff (l+1,r+1) ds+ 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+ show (Lines _ s) = show $ trim s instance Show ShellTest where show ShellTest{testname=n,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} =
shelltestrunner.cabal view
@@ -1,80 +1,22 @@ name: shelltestrunner -- keep synced with shelltest.hs:-version: 0.9+version: 1.0 category: Testing synopsis: A tool for testing command-line programs. description:- This tool aims to help with repeatable testing of a command-line program- (or any shell command), via declarative \"shell tests\" which are easier- to write than procedural shell scripts. Tests are defined in one or more- test files, which typically have the .test suffix and live in a tests/- subdirectory. Each test specifies a command line, optional standard input,- and expected standard output, error output and/or exit status. Tests can- be run in parallel for greater speed. shelltestrunner was inspired by the- tests in John Wiegley's ledger project.- . - Compatibility: should work on microsoft windows as well as unix; not well- tested on windows. Should build with ghc 6.10; for unicode support,- requires ghc 6.12.- .- Usage:- .- > shelltest [FLAG] [TESTFILES|TESTDIRS]- > - > -? --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- > -c --color display with ANSI color codes- > --execdir run tests in same directory as test file- > --extension=EXT extension of test files when dirs specified (default=.test)- > -i --implicit=none|exit|all provide implicit tests (default=exit)- > -w --with=EXECUTABLE alternate executable, replaces the first word of test commands- > =OTHER FLAGS any other flags are passed to test runner- > - > A test file contains one or more shell tests, which look like this:- > - > # optional comment lines- > a one-line shell command to be tested- > <<<- > stdin lines- > >>> [/regexp to match in stdout/]- > [or expected stdout lines- > >>>2 [/regexp to match in stderr/]- > [or expected stderr lines]- > >>>= expected exit status or /regexp/- > - > The command line is required; all other fields are optional.- > The expected stdout (>>>) and expected stderr (>>>2) fields can have either- > a regular expression match pattern, 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. The expected exit status (>>>=) field can have- > either a numeric exit code or a /regexp/. A ! preceding a /regexp/ or exit- > code negates the match. The regular expression syntax is that of the- > pcre-light library with the dotall flag.- > - > By default there is an implicit test for exit status=0, but no implicit test- > for stdout or stderr. You can change this with -i/--implicit-tests.- > - > The command runs in your current directory unless you use --execdir.- > You can use --with/-w to replace the first word of command lines- > (everything up to the first space) with something else, eg to test a- > different version of your program. To prevent this, start the command line- > with a space.- > - > 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 -j8.-+ shelltestrunner is a handy cross-platform tool for testing command-line+ programs or arbitrary shell commands. It reads simple declarative tests+ specifying a command, some input, and the expected output, error output+ and exit status. Tests can be run selectively, in parallel, with a+ timeout, in color, and/or with differences highlighted. license: GPL license-file: LICENSE author: Simon Michael <simon@joyful.com> maintainer: Simon Michael <simon@joyful.com>-homepage: http://joyful.com/darcsweb/darcsweb.cgi?r=shelltestrunner+homepage: http://joyful.com/repos/shelltestrunner bug-reports: mailto:simon@joyful.com stability: beta-tested-with: GHC==6.12+tested-with: GHC==6.12, GHC==7.0 cabal-version: >= 1.6 build-type: Simple @@ -85,18 +27,19 @@ main-is: shelltest.hs ghc-options: -threaded -W -fwarn-tabs build-depends:- base >= 3 && < 5- ,FileManipCompat >= 0.15 && < 0.16+ base >= 4 && < 5+ ,FileManipCompat >= 0.18 && < 0.19 ,HUnit < 1.3- ,cmdargs >= 0.1 && < 0.2- ,directory == 1.0.*- ,filepath >= 1.0 && < 1.2+ ,cmdargs >= 0.7 && < 0.8+ ,directory >= 1.0+ ,filepath >= 1.0 ,parsec < 3.2 ,regex-tdfa >= 1.1 && < 1.2 ,process < 1.1- ,test-framework >= 0.3.2 && < 0.4+ ,test-framework >= 0.3.2 && < 0.5 ,test-framework-hunit >= 0.2 && < 0.3 ,utf8-string >= 0.3.5 && < 0.4+ ,Diff >= 0.1 && < 0.2 source-repository head type: darcs