diff --git a/shelltestrunner.cabal b/shelltestrunner.cabal --- a/shelltestrunner.cabal +++ b/shelltestrunner.cabal @@ -1,7 +1,7 @@ name: shelltestrunner -version: 0.2 +version: 0.3 category: Testing -synopsis: A handy tool for testing command-line programs. +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: @@ -10,10 +10,9 @@ was extracted from the hledger project, and inspired by the tests in John Wiegley's ledger project. - This uses test-framework's test runner. Output order - is currently a bit mixed up. Any command-line options - are passed through to the test-framework runner, but - they must not contain spaces, so use eg -tpattern not + 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. @@ -23,6 +22,7 @@ Test file format: + ; 0 or more comment lines beginning with ; -opt1 -opt2 arg1 arg2 <<< 0 or more lines of input @@ -30,14 +30,21 @@ 0 or more lines of expected output >>>2 0 or more lines of expected error output - <<>> + >>>= + expected numeric exit code - Lines whose first non-whitespace character is ; are - ignored, mostly. The first line is the command line, - to be appended to the executable name. All remaining - fields are optional; when omitted they are assumed - to be "", "", "", and 0 respectively. + 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 + license: GPL license-file: LICENSE author: Simon Michael @@ -62,3 +69,4 @@ ,HUnit ,test-framework ,test-framework-hunit >= 0.2 && < 0.3 + ,parseargs >= 0.1 && < 0.2 diff --git a/shelltestrunner.hs b/shelltestrunner.hs --- a/shelltestrunner.hs +++ b/shelltestrunner.hs @@ -3,40 +3,7 @@ shelltestrunner - a handy tool for testing command-line programs. -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. Output order is currently a -bit mixed up. 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: - -$ ghc --make -threaded ./shelltestrunner.hs -$ ./shelltestrunner [testrunneropts] executable testfile1 [testfile2 ...] - -Test file format: - -@ --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 -<<>> -@ - -Lines whose first non-whitespace character is ; are ignored, mostly. -The first line is the command line, to be appended to the executable -name. All remaining fields are optional; when omitted they are -assumed to be "", "", "", and 0 respectively. +See shelltestrunner.cabal. (c) Simon Michael 2009, released under GNU GPLv3 @@ -44,23 +11,56 @@ module Main where +--import Control.Concurrent (forkIO) import Control.Monad (liftM,when) import Data.List (partition) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe,fromJust) import qualified Test.HUnit (Test) -import System.Environment (getArgs,withArgs) -import System.Exit (ExitCode(..)) +import System.Console.ParseArgs hiding (args) +import System.Environment (withArgs) +import System.Exit (ExitCode(..),exitWith) import System.IO (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 Debug.Trace --- strace :: Show a => a -> a --- strace a = trace (show a) a +import Debug.Trace +strace :: Show a => a -> a +strace a = trace (show a) a +version :: String +version = "0.3" -- sync with .cabal + +data ArgId = HelpFlag + | VersionFlag + | ExecutableArg + deriving (Ord, Eq, Show) + +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 = ExecutableArg, + argName = Nothing, + argAbbr = Nothing, + argData = argDataRequired "executable" ArgtypeString, + argDesc = "executable program or shell command to test, should accept stdin" + } + ] + data ShellTest = ShellTest { filename :: String ,command :: String @@ -72,13 +72,21 @@ main :: IO () main = do - args <- getArgs - let (opts,args') = partition ((=="-").take 1) args - args'' = if null args' && ("--help" `elem` opts) then [""] else args' -- temp - (exe:files) = args'' - shelltests <- mapM parseShellTest files - withArgs opts $ defaultMain $ concatMap (hUnitTestToTests.shellTestToHUnitTest exe) shelltests + 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 + 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 +printVersion :: IO () +printVersion = putStrLn version >> exitWith ExitSuccess + +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} @@ -89,6 +97,7 @@ shelltest = do st <- getParserState let f = sourceName $ statePos st + many commentline c <- commandline i <- optionMaybe input o <- optionMaybe expectedoutput @@ -96,22 +105,28 @@ x <- optionMaybe expectedexitcode return ShellTest{filename=f,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} -commandline,input,expectedoutput,expectederror,delimiter,line :: Parser String +line,commentline,commandline,delimiter,input,expectedoutput,expectederror :: Parser String + +line = anyChar `manyTill` newline + +commentline = char ';' >> anyChar `manyTill` newline + +-- noncommentline = do +-- l <- line +-- if take 1 (strip l) == ";" then line else return l + commandline = line -input = string "<<<\n" >> (liftM unlines) (line `manyTill` (lookAhead delimiter)) -expectedoutput = try $ string ">>>" >> optional (char '1') >> char '\n' >> (liftM unlines) (line `manyTill` (lookAhead delimiter)) -expectederror = string ">>>2" >> (liftM $ unlines.tail) (line `manyTill` (lookAhead delimiter)) -- why tail ? + delimiter = choice [try $ string "<<<", try $ string ">>>", (eof >> return "")] -line = do - l <- anyChar `manyTill` newline - if take 1 (strip l) == ";" then line else return l +input = string "<<<\n" >> (liftM unlines) (line `manyTill` (lookAhead delimiter)) + +expectedoutput = try $ string ">>>" >> optional (char '1') >> newline >> (liftM unlines) (line `manyTill` (lookAhead delimiter)) + +expectederror = try $ string ">>>2\n" >> (liftM unlines) (line `manyTill` (lookAhead delimiter)) + expectedexitcode :: Parser ExitCode -expectedexitcode = do - string "<<<" - c <- liftM (toExitCode.read) line - string ">>>" - return c +expectedexitcode = string ">>>=" >> (liftM (toExitCode.read.unlines) (line `manyTill` eof)) runShellTest :: FilePath -> ShellTest -> IO Bool runShellTest exe ShellTest{ @@ -119,11 +134,16 @@ let cmd = unwords [exe,c] (i',o',e',x') = (fromMaybe "" i, fromMaybe "" o, fromMaybe "" e, fromMaybe ExitSuccess x) -- printf "%s .. " f; hFlush stdout + (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 + let (outputok, errorok, exitok) = (out==o', err==e', exit==x') if outputok && errorok && exitok then do @@ -137,7 +157,7 @@ return False printExpectedActual :: String -> String -> String -> IO () -printExpectedActual f e a = hPutStr stderr $ printf "**Expected %s:\n%s**Got:\n%s" f e a +printExpectedActual f e a = hPutStr stderr $ printf "**Expected %s:\n%s**Got %s:\n%s" f e f a toExitCode :: Int -> ExitCode toExitCode 0 = ExitSuccess