diff --git a/Tests.hs b/Tests.hs index 85de18a86..1ba47a503 100644 --- a/Tests.hs +++ b/Tests.hs @@ -1,4 +1,80 @@ --- see also +{- | +hledger's test suite. Most tests are HUnit-based, and defined in the +@tests@ list below. These tests are built in to hledger and can be run at +any time with @hledger test@. + +In addition, we have tests in doctest format, which can be run with @make +doctest@ in the hledger source tree. These have some advantages: + +- easier to read and write than hunit, for functional/shell tests + +- easier to read multi-line output from failing tests + +- can also appear in, and test, docs + +and disadvantages: + +- not included in hledger's built-in tests + +- not platform independent + +All doctests are included below. Some of these may also appear in other +modules as examples within the api docs. + +Run a few with c++ ledger first: + +@ +$ ledger -f sample.ledger balance + $-1 assets + $1 bank:saving + $-2 cash + $2 expenses + $1 food + $1 supplies + $-2 income + $-1 gifts + $-1 salary + $1 liabilities:debts +@ + +@ +$ ledger -f sample.ledger balance o + $1 expenses:food + $-2 income + $-1 gifts + $-1 salary +-------------------- + $-1 +@ + +Then hledger: + +@ +$ hledger -f sample.ledger balance + $-1 assets + $1 bank:saving + $-2 cash + $2 expenses + $1 food + $1 supplies + $-2 income + $-1 gifts + $-1 salary + $1 liabilities:debts +@ + +@ +$ hledger -f sample.ledger balance o + $1 expenses:food + $-2 income + $-1 gifts + $-1 salary +-------------------- + $-1 +@ + +-} +-- other test tools: -- http://hackage.haskell.org/cgi-bin/hackage-scripts/package/test-framework -- http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HTF diff --git a/tools/doctest.hs b/tools/doctest.hs new file mode 100644 index 000000000..f82464d3f --- /dev/null +++ b/tools/doctest.hs @@ -0,0 +1,86 @@ +#!/usr/bin/env runhaskell +{- | +Extract (shell) tests from haddock comments in Haskell code, run them and +verify expected output, like Python's doctest system. + +Here, a doctest is a haddock literal block whose first line begins with a +$ (leading whitespace ignored). The rest of the line is a shell command +and the remaining lines are the expected output. + +Usage example: $ doctest.hs doctest.hs + +Doctest examples: + +@ +$ ls doctest.hs +This doctest will fail. +@ + +@ +$ ls doctest.hs +doctest.hs +@ + +After writing this I found the doctest on hackage; that one runs haskell +expressions in comments, converting them to hunit tests. We might add this +to that, and/or add this to hledger's built-in test runner. + +-} + +module Main where +import Data.List (isPrefixOf) +import System (getArgs) +import System.Exit (ExitCode(ExitSuccess)) +import System.IO (hGetContents) +import System.Process (runInteractiveCommand, waitForProcess) +import Text.Printf (printf) + +main = do + f <- head `fmap` getArgs + s <- readFile f + let tests = doctests s + putStrLn $ printf "running %d doctests from %s" (length tests) f + mapM_ runShellDocTest $ doctests s + +runShellDocTest :: String -> IO Bool +runShellDocTest s = do + let (cmd, expected) = splitDocTest s + putStr $ printf "testing: %s .. " cmd + (_, out, _, h) <- runInteractiveCommand cmd + exit <- waitForProcess h + output <- hGetContents out + if exit == ExitSuccess + then + if output == expected + then do + putStrLn "ok" + return True + else do + putStr $ printf "FAILED\nexpected:\n%sgot:\n%s" expected output + return False + else do + putStrLn $ printf "ERROR: %s" (show exit) + return False + +splitDocTest s = (strip $ drop 1 $ strip $ head ls, unlines $ tail ls) + where ls = lines s + +-- extract doctests from haskell source code +doctests :: String -> [String] +doctests s = filter isDocTest $ haddockLiterals s + where + isDocTest s = (("$" `isPrefixOf`) . dropws) $ head $ lines s + +-- extract haddock literal blocks from haskell source code +haddockLiterals :: String -> [String] +haddockLiterals "" = [] +haddockLiterals s | null lit = [] + | otherwise = [lit] ++ haddockLiterals rest + where + ls = drop 1 $ dropWhile (not . isLiteralBoundary) $ lines s + lit = unlines $ takeWhile (not . isLiteralBoundary) ls + rest = unlines $ drop 1 $ dropWhile (not . isLiteralBoundary) ls + isLiteralBoundary = (== "@") . strip + +strip = dropws . reverse . dropws . reverse +dropws = dropWhile (`elem` " \t")