packages feed

shelltestrunner 0.3 → 0.4

raw patch · 2 files changed

+240/−112 lines, 2 filesdep +regexpr

Dependencies added: regexpr

Files

shelltestrunner.cabal view
@@ -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 ...] [-- <test-framework runner opts>]+ .+ 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 <simon@joyful.com>@@ -70,3 +84,4 @@                 ,test-framework                 ,test-framework-hunit >= 0.2 && < 0.3                 ,parseargs >= 0.1 && < 0.2+                ,regexpr >= 0.5.1
shelltestrunner.hs view
@@ -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