mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 10:17:35 +03:00
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