shelltestrunner now packaged separately, update tests for it
This commit is contained in:
		
							parent
							
								
									f1f4a0c023
								
							
						
					
					
						commit
						cb0a90cbd7
					
				
							
								
								
									
										11
									
								
								Makefile
									
									
									
									
									
								
							
							
						
						
									
										11
									
								
								Makefile
									
									
									
									
									
								
							| @ -87,10 +87,6 @@ continuous ci: setversion | ||||
| tools/unittest: tools/unittest.hs | ||||
| 	ghc --make -threaded -O2 tools/unittest.hs | ||||
| 
 | ||||
| # build the shell test runner. Requires test-framework.
 | ||||
| tools/shelltest: tools/shelltest.hs | ||||
| 	ghc --make -threaded -O2 tools/shelltest.hs | ||||
| 
 | ||||
| # build the doctest runner
 | ||||
| tools/doctest: tools/doctest.hs | ||||
| 	ghc --make tools/doctest.hs | ||||
| @ -134,9 +130,10 @@ unittesths: | ||||
| 	@(runghc hledger.hs test \
 | ||||
| 		&& echo $@ passed) || echo $@ FAILED | ||||
| 
 | ||||
| # run functional tests
 | ||||
| functest: tools/shelltest | ||||
| 	@(tools/shelltest tests/*.test -j8 \
 | ||||
| # run functional tests, requires shelltestrunner from hackage
 | ||||
| # -j8 not working yet
 | ||||
| functest: hledger | ||||
| 	@(shelltestrunner ./hledger tests/*.test \
 | ||||
| 		&& echo $@ passed) || echo $@ FAILED | ||||
| 
 | ||||
| # run doc tests
 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| # ignore the binary we are invoked with | ||||
| -f/dev/null; echo "2009/1/32" | hledger add 2>&1 | tail -1 | sed -e's/\[[^]]*\]//g' | ||||
| >>> | ||||
| date : date :  | ||||
| -f/dev/null; echo "2009/1/32" | hledger add 2>&1 | sed -e's/\[[^]]*\]//g' | grep -q 'date : date :' | ||||
| >>>= | ||||
| 0 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| # ignore the binary we are invoked with | ||||
| -f/dev/null; echo | hledger add 2>&1 |tail -1 |sed -e's/\[[^]]*\]//g' | ||||
| >>> | ||||
| date : description:  | ||||
| -f/dev/null; echo | hledger add 2>&1 |sed -e's/\[[^]]*\]//g' | grep -q 'date : description:' | ||||
| >>>= | ||||
| 0 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| # ignore the binary we are invoked with | ||||
| -f/dev/null; printf "\n\n" | hledger add 2>&1 |tail -1 | sed -e's/\[[^]]*\]//g' | ||||
| >>> | ||||
| date : description: description:  | ||||
| -f/dev/null; printf "\n\n" | hledger add 2>&1 | sed -e's/\[[^]]*\]//g' | grep -q 'date : description: description:' | ||||
| >>>= | ||||
| 0 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| print | ||||
| -f - print | ||||
| <<< | ||||
| 2009/1/1 x | ||||
|  a  1 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| print | ||||
| -f - print | ||||
| <<< | ||||
| 2009/01/01 x | ||||
|     a  1 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| print | ||||
| -f - print | ||||
| <<< | ||||
| 2009/01/01 x | ||||
|     ; comment line within postings | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| balance -p 'in 2009' --effective | ||||
| -f - balance -p 'in 2009' --effective | ||||
| <<< | ||||
| 2009/1/1 x | ||||
|   a  1 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| print --effective | ||||
| -f - print --effective | ||||
| <<< | ||||
| 2009/1/1[=2010/1/1] x | ||||
|   a  1 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| register --effective | ||||
| -f - register --effective | ||||
| <<< | ||||
| 2009/1/1[=2010/1/1] x | ||||
|   a  1 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| balance | ||||
| -f - balance | ||||
| <<< | ||||
| 2009/1/1 x | ||||
|  aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa  €1 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| register | ||||
| -f - register | ||||
| <<< | ||||
| 2009/6/24 carwash | ||||
|     equity:draw:personal:transportation:car:carwash     $3.50 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| balance -E | ||||
| -f - balance -E | ||||
| <<< | ||||
| 2009/1/1 x | ||||
|  a:  13 | ||||
| @ -7,4 +7,5 @@ balance -E | ||||
| hledger: parse error at (line 1, column 4): | ||||
| unexpected " " | ||||
| accountname seems ill-formed: a: | ||||
| ===1 | ||||
| >>>= | ||||
| 1 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| print | ||||
| -f - print | ||||
| <<< | ||||
| 2009-01-01 x | ||||
|   a  2 | ||||
|  | ||||
| @ -1,5 +1,5 @@ | ||||
| # shouldn't exit code be 1 ? | ||||
| register | ||||
| -f - register | ||||
| <<< | ||||
| 2009/1/1 a | ||||
|   b  1.1 | ||||
| @ -13,4 +13,5 @@ could not balance this transaction, amounts do not add up to zero: | ||||
|     c                                             -1 | ||||
| 
 | ||||
| 
 | ||||
| ===0 | ||||
| >>>= | ||||
| 0 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| register τράπ | ||||
| -f - register τράπ | ||||
| <<< | ||||
| 2009-01-01 проверка | ||||
|   τράπεζα  10 руб | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| balance | ||||
| -f - balance | ||||
| <<< | ||||
| 2009-01-01 проверка | ||||
|   τράπεζα  10 руб | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| register desc:аура | ||||
| -f - register desc:аура | ||||
| <<< | ||||
| 2009-01-01 аура (cyrillic letters) | ||||
|   bank  10 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| balance | ||||
| -f - balance | ||||
| <<< | ||||
| 2009-01-01 broken entry | ||||
|   дебит    1 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| print | ||||
| -f - print | ||||
| <<< | ||||
| 2009-01-01 проверка | ||||
|  счёт:первый  1 | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| register | ||||
| -f - register | ||||
| <<< | ||||
| 2009-01-01 проверка | ||||
|   τράπεζα  10 руб | ||||
|  | ||||
| @ -1,4 +1,4 @@ | ||||
| print | ||||
| -f - print | ||||
| <<< | ||||
| 2009/1/1 x | ||||
|   (virtual)  100 | ||||
|  | ||||
| @ -1,157 +0,0 @@ | ||||
| #!/usr/bin/env runhaskell | ||||
| {- | ||||
| 
 | ||||
| shelltest.hs (c) 2009 Simon Michael <simon@joyful.com> | ||||
| 
 | ||||
| Run one or more hledger command-line tests, specified by .test files like | ||||
| those used in the ledger project. A ledger-style .test file contains a | ||||
| partial command line, input, expected output, expected error output, and | ||||
| expected exit code separated by delimiters. | ||||
| 
 | ||||
| Usage: $ shelltest [OPTS] *.test | ||||
| 
 | ||||
| This version uses the test-framework test runner. Any command-line arguments | ||||
| beginning with - are passed through to that. So avoid spaces: use -tpattern | ||||
| not -t pattern. To get a speedup, try adding -j8. | ||||
| 
 | ||||
| Here is the .test file format: | ||||
| @ | ||||
| --option1 arg1 arg2 | ||||
| <<< | ||||
| lines of | ||||
| input | ||||
| >>> | ||||
| expected | ||||
| output | ||||
| >>>2 | ||||
| expected | ||||
| error output | ||||
| ===0 | ||||
| ; | ||||
| ; Lines whose first non-whitespace character is ; are ignored. | ||||
| ; The first line is the command line. "hledger" is prepended, and "-f-" is | ||||
| ; appended unless there is a -f or <... argument, in which case any | ||||
| ; provided input is ignored. | ||||
| ; Then there is a line containing <<< and 0 or more lines of input. | ||||
| ; Then a line containing >>> (or >>>1 for ledger testrunner compatibility) | ||||
| ; and 0 or more lines of expected output. | ||||
| ; Then a line containing >>>2 and 0 or more lines of expected stderr output. | ||||
| ; Then === and the expected exit code (on the same line). | ||||
| ; All fields except for the command line are optional, when omitted they | ||||
| ; are assumed to be "", "", "", and 0 respectively. | ||||
| @ | ||||
| -} | ||||
| 
 | ||||
| module Main where | ||||
| --import System (getArgs) | ||||
| import System.Environment (getArgs,withArgs) | ||||
| import System.Exit (exitFailure, exitWith, ExitCode(..)) | ||||
| import System.IO (hGetContents, hPutStr, stderr {-, stdout, hFlush-}) | ||||
| import System.Process (runInteractiveCommand, waitForProcess) | ||||
| import Text.Printf (printf) | ||||
| import Text.ParserCombinators.Parsec | ||||
| import Control.Monad (liftM,when) | ||||
| import Data.Maybe (fromMaybe) | ||||
| import Data.List (partition) | ||||
| 
 | ||||
| import Test.Framework (defaultMain {-, testGroup-}) | ||||
| import Test.Framework.Providers.HUnit (hUnitTestToTests) | ||||
| --import Test.Framework.Providers.QuickCheck2 (testProperty) | ||||
| import Test.HUnit hiding (Test) | ||||
| import qualified Test.HUnit (Test) | ||||
| --import Test.QuickCheck | ||||
| --import Tests (tests) | ||||
| 
 | ||||
| import Debug.Trace | ||||
| strace :: Show a => a -> a | ||||
| strace a = trace (show a) a | ||||
| 
 | ||||
| 
 | ||||
| exe :: String | ||||
| exe = "hledger" | ||||
| 
 | ||||
| data ShellTest = ShellTest { | ||||
|      filename         :: String | ||||
|     ,command          :: String | ||||
|     ,stdin            :: Maybe String | ||||
|     ,stdoutExpected   :: Maybe String | ||||
|     ,stderrExpected   :: Maybe String | ||||
|     ,exitCodeExpected :: Maybe ExitCode | ||||
|     } deriving (Show) | ||||
| 
 | ||||
| main :: IO () | ||||
| main = do | ||||
|   args <- getArgs | ||||
|   let (opts,files) = partition ((=="-").take 1) args | ||||
|   shelltests <-  mapM parseShellTest files | ||||
|   withArgs opts $ defaultMain $ concatMap (hUnitTestToTests.shellTestToHUnitTest) shelltests | ||||
| 
 | ||||
| shellTestToHUnitTest :: ShellTest -> Test.HUnit.Test | ||||
| shellTestToHUnitTest t = filename t ~: do {r <- runShellTest t; assertBool "" r} | ||||
| 
 | ||||
| parseShellTest :: FilePath -> IO ShellTest | ||||
| parseShellTest = liftM (either (error.show) id) . parseFromFile shelltest | ||||
| 
 | ||||
| shelltest :: Parser ShellTest | ||||
| shelltest = do | ||||
|   st <- getParserState | ||||
|   let f = sourceName $ statePos st | ||||
|   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} | ||||
| 
 | ||||
| commandline,input,expectedoutput,expectederror,delimiter,line :: Parser String | ||||
| 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 ">>>", try $ string "===", (eof >> return "")] | ||||
| line =  do | ||||
|   l <- anyChar `manyTill` newline | ||||
|   if take 1 (strip l) == ";" then line else return l | ||||
| expectedexitcode :: Parser ExitCode | ||||
| expectedexitcode = string "===" >> liftM (toExitCode.read) line -- `catch` (\e -> fail (show e)) | ||||
| 
 | ||||
| runShellTest :: ShellTest -> IO Bool | ||||
| runShellTest ShellTest{ | ||||
|     filename=_,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} = do | ||||
|   let cmd = unwords [exe,c,if (any isinputarg $ words c) then "" else "-f-"] | ||||
|             where isinputarg a = take 2 a == "-f" || (take 1 a == "<") | ||||
|       (i',o',e',x') = (fromMaybe "" i, fromMaybe "" o, fromMaybe "" e, fromMaybe ExitSuccess x) | ||||
|   -- printf "%s .. " f; hFlush stdout | ||||
|   (ih,oh,eh,ph) <- runInteractiveCommand cmd | ||||
|   hPutStr ih i' | ||||
|   out <- hGetContents oh | ||||
|   err <- hGetContents eh | ||||
|   exit <- waitForProcess ph | ||||
|   let (outputok, errorok, exitok) = (out==o', err==e', exit==x') | ||||
|   if outputok && errorok && exitok  | ||||
|    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") | ||||
|      return False | ||||
| 
 | ||||
| printExpectedActual :: String -> String -> String -> IO () | ||||
| printExpectedActual f e a = hPutStr stderr $ printf "**Expected %s:\n%s**Got:\n%s" f e a | ||||
| 
 | ||||
| toExitCode :: Int -> ExitCode | ||||
| toExitCode 0 = ExitSuccess | ||||
| toExitCode n = ExitFailure n | ||||
| 
 | ||||
| fromExitCode :: ExitCode -> Int | ||||
| fromExitCode ExitSuccess     = 0 | ||||
| fromExitCode (ExitFailure n) = n | ||||
| 
 | ||||
| strip,lstrip,rstrip,dropws :: String -> String | ||||
| strip = lstrip . rstrip | ||||
| lstrip = dropws | ||||
| rstrip = reverse . dropws . reverse | ||||
| dropws = dropWhile (`elem` " \t") | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user