diff --git a/shelltest.hs b/shelltest.hs --- a/shelltest.hs +++ b/shelltest.hs @@ -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} = diff --git a/shelltestrunner.cabal b/shelltestrunner.cabal --- a/shelltestrunner.cabal +++ b/shelltestrunner.cabal @@ -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 maintainer: Simon Michael -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