shelltest: make fields in .test files optional

This commit is contained in:
Simon Michael 2009-06-27 10:18:34 +00:00
parent a6cc0effe5
commit ba47853501
6 changed files with 36 additions and 37 deletions

View File

@ -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

View File

@ -1,9 +1,6 @@
-f sample.ledger balance --depth 1
<<<
>>>
$-1 assets
$2 expenses
$-2 income
$1 liabilities
>>>2
===0

View File

@ -1,11 +1,8 @@
-f sample.ledger balance o
<<<
>>>1
>>>
$1 expenses:food
$-2 income
$-1 gifts
$-1 salary
--------------------
$-1
>>>2
===0

View File

@ -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

View File

@ -4,7 +4,6 @@ register
2009/1/1 a
b 1.1
c -1
>>>
>>>2
"-" (line 4, column 1):
unexpected end of input

View File

@ -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 ()