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