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 | tools/unittest: tools/unittest.hs | ||||||
| 	ghc --make -threaded -O2 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
 | # build the doctest runner
 | ||||||
| tools/doctest: tools/doctest.hs | tools/doctest: tools/doctest.hs | ||||||
| 	ghc --make tools/doctest.hs | 	ghc --make tools/doctest.hs | ||||||
| @ -134,9 +130,10 @@ unittesths: | |||||||
| 	@(runghc hledger.hs test \
 | 	@(runghc hledger.hs test \
 | ||||||
| 		&& echo $@ passed) || echo $@ FAILED | 		&& echo $@ passed) || echo $@ FAILED | ||||||
| 
 | 
 | ||||||
| # run functional tests
 | # run functional tests, requires shelltestrunner from hackage
 | ||||||
| functest: tools/shelltest | # -j8 not working yet
 | ||||||
| 	@(tools/shelltest tests/*.test -j8 \
 | functest: hledger | ||||||
|  | 	@(shelltestrunner ./hledger tests/*.test \
 | ||||||
| 		&& echo $@ passed) || echo $@ FAILED | 		&& echo $@ passed) || echo $@ FAILED | ||||||
| 
 | 
 | ||||||
| # run doc tests
 | # run doc tests
 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| # ignore the binary we are invoked with | # ignore the binary we are invoked with | ||||||
| -f/dev/null; echo "2009/1/32" | hledger add 2>&1 | tail -1 | sed -e's/\[[^]]*\]//g' | -f/dev/null; echo "2009/1/32" | hledger add 2>&1 | sed -e's/\[[^]]*\]//g' | grep -q 'date : date :' | ||||||
| >>> | >>>= | ||||||
| date : date :  | 0 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| # ignore the binary we are invoked with | # ignore the binary we are invoked with | ||||||
| -f/dev/null; echo | hledger add 2>&1 |tail -1 |sed -e's/\[[^]]*\]//g' | -f/dev/null; echo | hledger add 2>&1 |sed -e's/\[[^]]*\]//g' | grep -q 'date : description:' | ||||||
| >>> | >>>= | ||||||
| date : description:  | 0 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| # ignore the binary we are invoked with | # ignore the binary we are invoked with | ||||||
| -f/dev/null; printf "\n\n" | hledger add 2>&1 |tail -1 | sed -e's/\[[^]]*\]//g' | -f/dev/null; printf "\n\n" | hledger add 2>&1 | sed -e's/\[[^]]*\]//g' | grep -q 'date : description: description:' | ||||||
| >>> | >>>= | ||||||
| date : description: description:  | 0 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| print | -f - print | ||||||
| <<< | <<< | ||||||
| 2009/1/1 x | 2009/1/1 x | ||||||
|  a  1 |  a  1 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| print | -f - print | ||||||
| <<< | <<< | ||||||
| 2009/01/01 x | 2009/01/01 x | ||||||
|     a  1 |     a  1 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| print | -f - print | ||||||
| <<< | <<< | ||||||
| 2009/01/01 x | 2009/01/01 x | ||||||
|     ; comment line within postings |     ; comment line within postings | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| balance -p 'in 2009' --effective | -f - balance -p 'in 2009' --effective | ||||||
| <<< | <<< | ||||||
| 2009/1/1 x | 2009/1/1 x | ||||||
|   a  1 |   a  1 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| print --effective | -f - print --effective | ||||||
| <<< | <<< | ||||||
| 2009/1/1[=2010/1/1] x | 2009/1/1[=2010/1/1] x | ||||||
|   a  1 |   a  1 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| register --effective | -f - register --effective | ||||||
| <<< | <<< | ||||||
| 2009/1/1[=2010/1/1] x | 2009/1/1[=2010/1/1] x | ||||||
|   a  1 |   a  1 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| balance | -f - balance | ||||||
| <<< | <<< | ||||||
| 2009/1/1 x | 2009/1/1 x | ||||||
|  aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa  €1 |  aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa  €1 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| register | -f - register | ||||||
| <<< | <<< | ||||||
| 2009/6/24 carwash | 2009/6/24 carwash | ||||||
|     equity:draw:personal:transportation:car:carwash     $3.50 |     equity:draw:personal:transportation:car:carwash     $3.50 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| balance -E | -f - balance -E | ||||||
| <<< | <<< | ||||||
| 2009/1/1 x | 2009/1/1 x | ||||||
|  a:  13 |  a:  13 | ||||||
| @ -7,4 +7,5 @@ balance -E | |||||||
| hledger: parse error at (line 1, column 4): | hledger: parse error at (line 1, column 4): | ||||||
| unexpected " " | unexpected " " | ||||||
| accountname seems ill-formed: a: | accountname seems ill-formed: a: | ||||||
| ===1 | >>>= | ||||||
|  | 1 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| print | -f - print | ||||||
| <<< | <<< | ||||||
| 2009-01-01 x | 2009-01-01 x | ||||||
|   a  2 |   a  2 | ||||||
|  | |||||||
| @ -1,5 +1,5 @@ | |||||||
| # shouldn't exit code be 1 ? | # shouldn't exit code be 1 ? | ||||||
| register | -f - register | ||||||
| <<< | <<< | ||||||
| 2009/1/1 a | 2009/1/1 a | ||||||
|   b  1.1 |   b  1.1 | ||||||
| @ -13,4 +13,5 @@ could not balance this transaction, amounts do not add up to zero: | |||||||
|     c                                             -1 |     c                                             -1 | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| ===0 | >>>= | ||||||
|  | 0 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| register τράπ | -f - register τράπ | ||||||
| <<< | <<< | ||||||
| 2009-01-01 проверка | 2009-01-01 проверка | ||||||
|   τράπεζα  10 руб |   τράπεζα  10 руб | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| balance | -f - balance | ||||||
| <<< | <<< | ||||||
| 2009-01-01 проверка | 2009-01-01 проверка | ||||||
|   τράπεζα  10 руб |   τράπεζα  10 руб | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| register desc:аура | -f - register desc:аура | ||||||
| <<< | <<< | ||||||
| 2009-01-01 аура (cyrillic letters) | 2009-01-01 аура (cyrillic letters) | ||||||
|   bank  10 |   bank  10 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| balance | -f - balance | ||||||
| <<< | <<< | ||||||
| 2009-01-01 broken entry | 2009-01-01 broken entry | ||||||
|   дебит    1 |   дебит    1 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| print | -f - print | ||||||
| <<< | <<< | ||||||
| 2009-01-01 проверка | 2009-01-01 проверка | ||||||
|  счёт:первый  1 |  счёт:первый  1 | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| register | -f - register | ||||||
| <<< | <<< | ||||||
| 2009-01-01 проверка | 2009-01-01 проверка | ||||||
|   τράπεζα  10 руб |   τράπεζα  10 руб | ||||||
|  | |||||||
| @ -1,4 +1,4 @@ | |||||||
| print | -f - print | ||||||
| <<< | <<< | ||||||
| 2009/1/1 x | 2009/1/1 x | ||||||
|   (virtual)  100 |   (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