mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-26 20:02:27 +03:00
shelltest: make fields in .test files optional
This commit is contained in:
parent
a6cc0effe5
commit
ba47853501
@ -5,7 +5,6 @@ register
|
||||
assets:cash
|
||||
[expenses:car] $3.50
|
||||
[simon]
|
||||
>>>
|
||||
>>>2
|
||||
"-" (line 6, column 1):
|
||||
unexpected end of input
|
||||
@ -17,4 +16,3 @@ could not balance this transaction, amounts do not add up to zero:
|
||||
[simon]
|
||||
|
||||
|
||||
===0
|
||||
|
@ -1,9 +1,6 @@
|
||||
-f sample.ledger balance --depth 1
|
||||
<<<
|
||||
>>>
|
||||
$-1 assets
|
||||
$2 expenses
|
||||
$-2 income
|
||||
$1 liabilities
|
||||
>>>2
|
||||
===0
|
||||
|
@ -1,11 +1,8 @@
|
||||
-f sample.ledger balance o
|
||||
<<<
|
||||
>>>1
|
||||
>>>
|
||||
$1 expenses:food
|
||||
$-2 income
|
||||
$-1 gifts
|
||||
$-1 salary
|
||||
--------------------
|
||||
$-1
|
||||
>>>2
|
||||
===0
|
||||
|
@ -1,6 +1,5 @@
|
||||
-f sample.ledger balance
|
||||
<<<
|
||||
>>>1
|
||||
>>>
|
||||
$-1 assets
|
||||
$1 bank:saving
|
||||
$-2 cash
|
||||
@ -11,5 +10,3 @@
|
||||
$-1 gifts
|
||||
$-1 salary
|
||||
$1 liabilities:debts
|
||||
>>>2
|
||||
===0
|
||||
|
@ -4,7 +4,6 @@ register
|
||||
2009/1/1 a
|
||||
b 1.1
|
||||
c -1
|
||||
>>>
|
||||
>>>2
|
||||
"-" (line 4, column 1):
|
||||
unexpected end of input
|
||||
|
@ -24,13 +24,15 @@ error output
|
||||
;
|
||||
; 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 the
|
||||
; 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.
|
||||
@
|
||||
-}
|
||||
|
||||
@ -42,16 +44,21 @@ import System.Process (runInteractiveCommand, waitForProcess)
|
||||
import Text.Printf (printf)
|
||||
import Text.ParserCombinators.Parsec
|
||||
import Control.Monad (liftM,when)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Debug.Trace
|
||||
strace :: Show a => a -> a
|
||||
strace a = trace (show a) a
|
||||
|
||||
|
||||
exe :: String
|
||||
exe = "hledger"
|
||||
|
||||
data ShellTest = ShellTest {
|
||||
command :: String
|
||||
,stdin :: String
|
||||
,stdoutExpected :: String
|
||||
,stderrExpected :: String
|
||||
,exitCodeExpected :: ExitCode
|
||||
,stdin :: Maybe String
|
||||
,stdoutExpected :: Maybe String
|
||||
,stderrExpected :: Maybe String
|
||||
,exitCodeExpected :: Maybe ExitCode
|
||||
} deriving (Show)
|
||||
|
||||
main :: IO ()
|
||||
@ -65,43 +72,47 @@ parseShellTest = liftM (either (error.show) id) . parseFromFile shelltest
|
||||
|
||||
shelltest :: Parser ShellTest
|
||||
shelltest = do
|
||||
c <- line; string "<<<\n"
|
||||
i <- line `manyTill` (string ">>>" >> optional (char '1') >> char '\n')
|
||||
o <- line `manyTill` (string ">>>2\n")
|
||||
e <- line `manyTill` (string "===")
|
||||
x <- line
|
||||
let x' = read x -- `catch` (\e -> fail (show e))
|
||||
eof
|
||||
return ShellTest{command=c,stdin=unlines i,stdoutExpected=unlines o,stderrExpected=unlines e,exitCodeExpected=toExitCode x'}
|
||||
c <- commandline
|
||||
i <- optionMaybe input
|
||||
o <- optionMaybe expectedoutput
|
||||
e <- optionMaybe expectederror
|
||||
x <- optionMaybe expectedexitcode
|
||||
return ShellTest{command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x}
|
||||
|
||||
line :: Parser String
|
||||
line = do
|
||||
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
|
||||
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{
|
||||
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 "Testing: %s" cmd; hFlush stdout
|
||||
(ih,oh,eh,ph) <- runInteractiveCommand cmd
|
||||
hPutStr ih i
|
||||
hPutStr ih i'
|
||||
out <- hGetContents oh
|
||||
err <- hGetContents eh
|
||||
exit <- waitForProcess ph
|
||||
let (outputok, errorok, exitok) = (out==o, err==e, exit==x)
|
||||
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")
|
||||
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 ()
|
||||
|
Loading…
Reference in New Issue
Block a user