diff --git a/Makefile b/Makefile index 1e7dad93e..468dcaf51 100644 --- a/Makefile +++ b/Makefile @@ -87,6 +87,10 @@ tools/bench: tools/bench.hs tools/doctest: tools/doctest.hs ghc --make tools/doctest.hs +# build the shell test runner +tools/shelltest: tools/shelltest.hs + ghc --make -threaded tools/shelltest.hs + # build the generateledger tool tools/generateledger: tools/generateledger.hs ghc --make tools/generateledger.hs @@ -112,6 +116,11 @@ unittest: @(runghc hledger.hs test \ && echo $@ passed) || echo $@ FAILED +# run functional tests +functest: tools/shelltest + @(tools/shelltest tests/*.test \ + && echo $@ passed) || echo $@ FAILED + # run doc tests doctest: tools/doctest @(tools/doctest Commands/Add.hs >/dev/null \ diff --git a/tools/shelltest.hs b/tools/shelltest.hs new file mode 100644 index 000000000..2eda35fef --- /dev/null +++ b/tools/shelltest.hs @@ -0,0 +1,122 @@ +#!/usr/bin/env runhaskell +{- + +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 *.test + +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 the +; 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). +@ +-} + +module Main where +import System (getArgs) +import System.Exit (exitFailure, exitWith, ExitCode(..)) +import System.IO (hGetContents, hPutStr, hFlush, stderr, stdout) +import System.Process (runInteractiveCommand, waitForProcess) +import Text.Printf (printf) +import Text.ParserCombinators.Parsec +import Control.Monad (liftM,when) + +exe :: String +exe = "hledger" + +data ShellTest = ShellTest { + command :: String + ,stdin :: String + ,stdoutExpected :: String + ,stderrExpected :: String + ,exitCodeExpected :: ExitCode + } deriving (Show) + +main :: IO () +main = do + files <- getArgs + ok <- mapM (\f -> parseShellTest f >>= runShellTest) files + if any not ok then exitFailure else exitWith ExitSuccess + +parseShellTest :: FilePath -> IO ShellTest +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'} + +line :: Parser String +line = do + l <- anyChar `manyTill` newline + if take 1 (strip l) == ";" + then line + else return l + +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 == "<") + printf "Testing: %s" cmd; 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")