slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

shelltest: show filename, not command, when running tests

Browse Source
This commit is contained in:
Simon Michael 2009-06-27 10:35:10 +00:00
parent ba47853501
commit e11c828aaf
1 changed files with 9 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
tools/shelltest.hs
View File

@ -54,7 +54,8 @@ exe :: String
exe = "hledger" exe = "hledger"
data ShellTest = ShellTest { data ShellTest = ShellTest {
command :: String filename :: String
,command :: String
,stdin :: Maybe String ,stdin :: Maybe String
,stdoutExpected :: Maybe String ,stdoutExpected :: Maybe String
,stderrExpected :: Maybe String ,stderrExpected :: Maybe String
@ -72,12 +73,14 @@ parseShellTest = liftM (either (error.show) id) . parseFromFile shelltest
shelltest :: Parser ShellTest shelltest :: Parser ShellTest
shelltest = do shelltest = do
st <- getParserState
let f = sourceName $ statePos st
c <- commandline c <- commandline
i <- optionMaybe input i <- optionMaybe input
o <- optionMaybe expectedoutput o <- optionMaybe expectedoutput
e <- optionMaybe expectederror e <- optionMaybe expectederror
x <- optionMaybe expectedexitcode x <- optionMaybe expectedexitcode
return ShellTest{command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} return ShellTest{filename=f,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x}
commandline,input,expectedoutput,expectederror,delimiter,line :: Parser String commandline,input,expectedoutput,expectederror,delimiter,line :: Parser String
commandline = line commandline = line
@ -93,11 +96,11 @@ expectedexitcode = string "===" >> liftM (toExitCode.read) line -- `catch` (\e -
runShellTest :: ShellTest -> IO Bool runShellTest :: ShellTest -> IO Bool
runShellTest ShellTest{ runShellTest ShellTest{
command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} = do filename=f,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} = do
let cmd = unwords [exe,c,if (any isinputarg $ words c) then "" else "-f-"] let cmd = unwords [exe,c,if (any isinputarg $ words c) then "" else "-f-"]
where isinputarg a = take 2 a == "-f" || (take 1 a == "<") where isinputarg a = take 2 a == "-f" || (take 1 a == "<")
(i',o',e',x') = (fromMaybe "" i, fromMaybe "" o, fromMaybe "" e, fromMaybe ExitSuccess x) (i',o',e',x') = (fromMaybe "" i, fromMaybe "" o, fromMaybe "" e, fromMaybe ExitSuccess x)
printf "Testing: %s" cmd; hFlush stdout printf "%s .. " f; hFlush stdout
(ih,oh,eh,ph) <- runInteractiveCommand cmd (ih,oh,eh,ph) <- runInteractiveCommand cmd
hPutStr ih i' hPutStr ih i'
out <- hGetContents oh out <- hGetContents oh
@ -106,10 +109,10 @@ runShellTest ShellTest{
let (outputok, errorok, exitok) = (out==o', err==e', exit==x') let (outputok, errorok, exitok) = (out==o', err==e', exit==x')
if outputok && errorok && exitok if outputok && errorok && exitok
then do then do
putStrLn " .. ok" putStrLn "ok"
return True return True
else do else do
hPutStr stderr $ printf " .. FAIL\n" hPutStr stderr $ printf "FAIL\n"
when (not outputok) $ printExpectedActual "stdout" o' out when (not outputok) $ printExpectedActual "stdout" o' out
when (not errorok) $ printExpectedActual "stderr" e' err when (not errorok) $ printExpectedActual "stderr" e' err
when (not exitok) $ printExpectedActual "exit code" (show (fromExitCode x')++"\n") (show (fromExitCode exit)++"\n") when (not exitok) $ printExpectedActual "exit code" (show (fromExitCode x')++"\n") (show (fromExitCode exit)++"\n")