test: refactor, document, organise easytests, port amountp tests (#812)
This commit is contained in:
		
							parent
							
								
									717a24a76d
								
							
						
					
					
						commit
						50d666d5a0
					
				| @ -1,14 +1,20 @@ | ||||
| {-# LANGUAGE OverloadedStrings #-} | ||||
| 
 | ||||
| module Hledger ( | ||||
|   module X | ||||
|  ,tests_Hledger | ||||
|  ,Hledger.easytests | ||||
| ) | ||||
| where | ||||
| import           Test.HUnit | ||||
| import           EasyTest | ||||
| 
 | ||||
| import           Hledger.Data    as X | ||||
| import           Hledger.Query   as X | ||||
| import           Hledger.Read    as X hiding (samplejournal) | ||||
| import           Hledger.Data    as X hiding (easytests) | ||||
| import qualified Hledger.Data    (easytests) | ||||
| import           Hledger.Read    as X hiding (samplejournal, easytests) | ||||
| import qualified Hledger.Read    (easytests) | ||||
| import           Hledger.Reports as X | ||||
| import           Hledger.Query   as X | ||||
| import           Hledger.Utils   as X | ||||
| 
 | ||||
| tests_Hledger = TestList | ||||
| @ -19,3 +25,8 @@ tests_Hledger = TestList | ||||
|     ,tests_Hledger_Reports | ||||
|     ,tests_Hledger_Utils | ||||
|     ] | ||||
| 
 | ||||
| easytests = scope "Hledger" $ tests [ | ||||
|    Hledger.Data.easytests | ||||
|   ,Hledger.Read.easytests | ||||
|   ] | ||||
|  | ||||
| @ -69,6 +69,7 @@ module Hledger.Data.Journal ( | ||||
|   -- * Tests | ||||
|   samplejournal, | ||||
|   tests_Hledger_Data_Journal, | ||||
|   easytests, | ||||
| ) | ||||
| where | ||||
| import Control.Applicative (Const(..)) | ||||
| @ -91,6 +92,7 @@ import Data.Ord | ||||
| import qualified Data.Semigroup as Sem | ||||
| import Data.Text (Text) | ||||
| import qualified Data.Text as T | ||||
| import EasyTest | ||||
| import Safe (headMay, headDef) | ||||
| import Data.Time.Calendar | ||||
| import Data.Tree | ||||
| @ -1085,3 +1087,24 @@ tests_Hledger_Data_Journal = TestList $ | ||||
|   --   journalBalanceSheetAccountNames j `is` ["assets","assets:a","equity","equity:q","equity:q:qq","liabilities","liabilities:l"] | ||||
|   --   journalProfitAndLossAccountNames j `is` ["expenses","expenses:e","income","income:i"] | ||||
|  ] | ||||
| 
 | ||||
| easytests = scope "Journal" $ tests [ | ||||
|   scope "standard account types" $ do | ||||
|     let | ||||
|       j = samplejournal | ||||
|       journalAccountNamesMatching :: Query -> Journal -> [AccountName] | ||||
|       journalAccountNamesMatching q = filter (q `matchesAccount`) . journalAccountNames | ||||
|       namesfrom qfunc = journalAccountNamesMatching (qfunc j) j | ||||
|     tests | ||||
|       [ scope "assets" $ | ||||
|         expectEq (namesfrom journalAssetAccountQuery)     ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"] | ||||
|       , scope "liabilities" $ | ||||
|         expectEq (namesfrom journalLiabilityAccountQuery) ["liabilities","liabilities:debts"] | ||||
|       , scope "equity" $ | ||||
|         expectEq (namesfrom journalEquityAccountQuery)    [] | ||||
|       , scope "income" $ | ||||
|         expectEq (namesfrom journalIncomeAccountQuery)    ["income","income:gifts","income:salary"] | ||||
|       , scope "expenses" $ | ||||
|         expectEq (namesfrom journalExpenseAccountQuery)   ["expenses","expenses:food","expenses:supplies"] | ||||
|       ] | ||||
|   ] | ||||
|  | ||||
| @ -31,6 +31,7 @@ module Hledger.Read ( | ||||
|   -- * Tests | ||||
|   samplejournal, | ||||
|   tests_Hledger_Read, | ||||
|   easytests, | ||||
| 
 | ||||
| ) where | ||||
| 
 | ||||
| @ -44,6 +45,7 @@ import Data.Ord | ||||
| import Data.Text (Text) | ||||
| import qualified Data.Text as T | ||||
| import Data.Time (Day) | ||||
| import EasyTest | ||||
| import Safe | ||||
| import System.Directory (doesFileExist, getHomeDirectory) | ||||
| import System.Environment (getEnv) | ||||
| @ -55,7 +57,8 @@ import Text.Printf | ||||
| 
 | ||||
| import Hledger.Data.Dates (getCurrentDay, parsedate, showDate) | ||||
| import Hledger.Data.Types | ||||
| import Hledger.Read.Common | ||||
| import Hledger.Read.Common hiding (easytests) | ||||
| import qualified Hledger.Read.Common (easytests) | ||||
| import qualified Hledger.Read.JournalReader   as JournalReader | ||||
| -- import qualified Hledger.Read.LedgerReader    as LedgerReader | ||||
| import qualified Hledger.Read.TimedotReader   as TimedotReader | ||||
| @ -360,3 +363,7 @@ tests_Hledger_Read = TestList $ | ||||
|     either error' (assertBool "journalp parsing an empty file should give an empty journal" . null . jtxns) jE | ||||
| 
 | ||||
|   ] | ||||
| 
 | ||||
| easytests = scope "Read" $ tests [ | ||||
|   Hledger.Read.Common.easytests | ||||
|   ] | ||||
|  | ||||
| @ -92,7 +92,8 @@ module Hledger.Read.Common ( | ||||
|   singlespacep, | ||||
| 
 | ||||
|   -- * tests | ||||
|   tests_Hledger_Read_Common | ||||
|   tests_Hledger_Read_Common, | ||||
|   Hledger.Read.Common.easytests | ||||
| ) | ||||
| where | ||||
| --- * imports | ||||
| @ -118,12 +119,13 @@ import Data.Time.Calendar | ||||
| import Data.Time.LocalTime | ||||
| import System.Time (getClockTime) | ||||
| import Test.HUnit | ||||
| import EasyTest hiding (char, char') | ||||
| import Text.Megaparsec | ||||
| import Text.Megaparsec.Char | ||||
| import Text.Megaparsec.Char.Lexer (decimal) | ||||
| import Text.Megaparsec.Custom | ||||
| 
 | ||||
| import Hledger.Data | ||||
| import Hledger.Data hiding (easytests) | ||||
| import Hledger.Utils | ||||
| 
 | ||||
| -- $setup | ||||
| @ -589,18 +591,6 @@ amountwithoutpricep = do | ||||
|           Left errMsg -> uncurry parseErrorAtRegion posRegion errMsg | ||||
|           Right res -> pure res | ||||
| 
 | ||||
| 
 | ||||
| test_amountp = TestCase $ do | ||||
|     assertParseEqual' (parseWithState mempty amountp "$47.18") (usd 47.18) | ||||
|     assertParseEqual' (parseWithState mempty amountp "$1.") (usd 1 `withPrecision` 0) | ||||
| -- TODO | ||||
| --    assertParseEqual'' "amount with unit price" | ||||
| --      (parseWithState mempty amountp "$10 @ €0.5") | ||||
| --      (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) | ||||
| --    assertParseEqual'' "amount with total price" | ||||
| --     (parseWithState mempty amountp "$10 @@ €5") | ||||
| --     (usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0)) | ||||
| 
 | ||||
| -- | Parse an amount from a string, or get an error. | ||||
| amountp' :: String -> Amount | ||||
| amountp' s = | ||||
| @ -1250,4 +1240,15 @@ match' p = do | ||||
|   (!txt, p) <- match p | ||||
|   pure (txt, p) | ||||
| 
 | ||||
| tests_Hledger_Read_Common = TestList [test_spaceandamountormissingp, test_amountp] | ||||
| tests_Hledger_Read_Common = TestList [ | ||||
|   test_spaceandamountormissingp | ||||
|   ] | ||||
| 
 | ||||
| easytests = scope "Common" $ tests [ | ||||
|   scope "amountp" $ tests [ | ||||
|     scope "basic"                  $ expectParseEq amountp "$47.18"     (usd 47.18) | ||||
|    ,scope "ends with decimal mark" $ expectParseEq amountp "$1."        (usd 1  `withPrecision` 0) | ||||
| --   ,scope "with unit price"        $ expectParseEq amountp "$10 @ €0.5" (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1))  | ||||
| --   ,scope "with total price"       $ expectParseEq amountp "$10 @@ €5"  (usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0)) | ||||
|     ] | ||||
|   ] | ||||
|  | ||||
| @ -1,23 +1,37 @@ | ||||
| {-# LANGUAGE OverloadedStrings #-} | ||||
| {-# LANGUAGE ScopedTypeVariables #-} | ||||
| 
 | ||||
| module Hledger.Utils.Test where | ||||
| 
 | ||||
| import Control.Exception | ||||
| import Control.Monad | ||||
| import Data.Functor.Identity | ||||
| import Test.HUnit | ||||
| import Data.List | ||||
| import qualified Data.Text as T | ||||
| import EasyTest | ||||
| import Safe  | ||||
| import System.Exit | ||||
| import System.IO | ||||
| import Test.HUnit as HUnit | ||||
| import Text.Megaparsec | ||||
| 
 | ||||
| import Hledger.Utils.Debug (pshow) | ||||
| import Hledger.Utils.Parse (parseWithState) | ||||
| import Hledger.Utils.UTF8IOCompat (error') | ||||
| 
 | ||||
| -- | Get a Test's label, or the empty string. | ||||
| testName :: Test -> String | ||||
| testName :: HUnit.Test -> String | ||||
| testName (TestLabel n _) = n | ||||
| testName _ = "" | ||||
| 
 | ||||
| -- | Flatten a Test containing TestLists into a list of single tests. | ||||
| flattenTests :: Test -> [Test] | ||||
| flattenTests :: HUnit.Test -> [HUnit.Test] | ||||
| flattenTests (TestLabel _ t@(TestList _)) = flattenTests t | ||||
| flattenTests (TestList ts) = concatMap flattenTests ts | ||||
| flattenTests t = [t] | ||||
| 
 | ||||
| -- | Filter TestLists in a Test, recursively, preserving the structure. | ||||
| filterTests :: (Test -> Bool) -> Test -> Test | ||||
| filterTests :: (HUnit.Test -> Bool) -> HUnit.Test -> HUnit.Test | ||||
| filterTests p (TestLabel l ts) = TestLabel l (filterTests p ts) | ||||
| filterTests p (TestList ts) = TestList $ filter (any p . flattenTests) $ map (filterTests p) ts | ||||
| filterTests _ t = t | ||||
| @ -58,3 +72,100 @@ assertParseEqual'' label parse expected = | ||||
| printParseError :: (Show a) => a -> IO () | ||||
| printParseError e = do putStr "parse error at "; print e | ||||
| 
 | ||||
| -- | Run some easytests, returning True if there was a problem. Catches ExitCode. | ||||
| -- With arguments, runs only tests in the scope named by the first argument | ||||
| -- (case sensitive).  | ||||
| -- If there is a second argument, it should be an integer and will be used | ||||
| -- as the seed for randomness.  | ||||
| runEasyTests :: [String] -> EasyTest.Test () -> IO Bool | ||||
| runEasyTests args easytests = (do | ||||
|   case args of | ||||
|     []    -> EasyTest.run easytests | ||||
|     [a]   -> EasyTest.runOnly (T.pack a) easytests | ||||
|     a:b:_ -> do | ||||
|       case readMay b :: Maybe Int of | ||||
|         Nothing   -> error' "the second argument should be an integer (a seed for easytest)" | ||||
|         Just seed -> EasyTest.rerunOnly seed (T.pack a) easytests | ||||
|   return False | ||||
|   ) | ||||
|   `catch` (\(_::ExitCode) -> return True) | ||||
| 
 | ||||
| expectParseEq parser input expected = do | ||||
|   let ep = runIdentity $ parseWithState mempty parser input | ||||
|   scope "parse succeeded" $ expectRight ep | ||||
|   let Right p = ep | ||||
|   scope "parse result" $ expectEq p expected | ||||
| 
 | ||||
| -- | Run some hunit tests, returning True if there was a problem. | ||||
| -- With arguments, runs only tests whose names contain the first argument | ||||
| -- (case sensitive).  | ||||
| runHunitTests :: [String] -> HUnit.Test -> IO Bool | ||||
| runHunitTests args hunittests = do | ||||
|   let ts =  | ||||
|         (case args of | ||||
|           a:_ -> filterTests ((a `isInfixOf`) . testName) | ||||
|           _   -> id | ||||
|         ) hunittests | ||||
|   results <- liftM (fst . flip (,) 0) $ runTestTTStdout ts | ||||
|   return $ errors results > 0 || failures results > 0 | ||||
|   where | ||||
|     -- | Like runTestTT but prints to stdout. | ||||
|     runTestTTStdout t = do | ||||
|       (counts, 0) <- HUnit.runTestText (putTextToHandle stdout True) t | ||||
|       return counts | ||||
| 
 | ||||
| --    matchedTests opts ts  | ||||
| --      | tree_ $ reportopts_ opts =  | ||||
| --        -- Tests, filtered by any arguments, in a flat list with simple names. | ||||
| --        TestList $ | ||||
| --          filter (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . T.pack . testName) $  | ||||
| --          flattenTests ts | ||||
| --      | otherwise =  | ||||
| --        -- Tests, filtered by any arguments, in the original suites with hierarchical names. | ||||
| --        filterTests (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . T.pack . testName)  | ||||
| --        ts | ||||
| 
 | ||||
| -- -- | Like runTestTT but can optionally not erase progress output. | ||||
| -- runTestTT' verbose t = do | ||||
| --   (counts, 0) <- runTestText' (f stderr True) t | ||||
| --   return counts | ||||
| --   where f | verbose   = putTextToHandle' | ||||
| --           | otherwise = putTextToHandle | ||||
| 
 | ||||
| -- -- | Like runTestText but also prints test names if any. | ||||
| -- runTestText' :: PutText st -> Test -> IO (Counts, st) | ||||
| -- runTestText' _pt _t@(TestLabel _label _) = error "HERE"  -- hPutStrLn stderr label >> runTestText pt t | ||||
| -- runTestText' pt t = runTestText pt t | ||||
| 
 | ||||
| -- -- runTestText' (PutText put us0) t = do | ||||
| -- --   (counts', us1) <- trace "XXX" $ performTest reportStart reportError reportFailure us0 t | ||||
| -- --   us2 <- put (showCounts counts' ++ " :::: " ++ testName t) True us1 | ||||
| -- --   return (counts', us2) | ||||
| -- --  where | ||||
| -- --   reportStart ss us = put (showCounts (counts ss)) False us | ||||
| -- --   reportError   = reportProblem "Error:"   "Error in:   " | ||||
| -- --   reportFailure = reportProblem "Failure:" "Failure in: " | ||||
| -- --   reportProblem p0 p1 loc msg ss us = put line True us | ||||
| -- --    where line  = "### " ++ kind ++ path' ++ "\n" ++ formatLocation loc ++ msg | ||||
| -- --          kind  = if null path' then p0 else p1 | ||||
| -- --          path' = showPath (path ss) | ||||
| 
 | ||||
| -- -- formatLocation :: Maybe SrcLoc -> String | ||||
| -- -- formatLocation Nothing = "" | ||||
| -- -- formatLocation (Just loc) = srcLocFile loc ++ ":" ++ show (srcLocStartLine loc) ++ "\n" | ||||
| 
 | ||||
| -- -- | Like putTextToHandle but does not erase progress lines. | ||||
| -- putTextToHandle' | ||||
| --     :: Handle | ||||
| --     -> Bool -- ^ Write progress lines to handle? | ||||
| --     -> PutText Int | ||||
| -- putTextToHandle' handle showProgress = PutText put initCnt | ||||
| --  where | ||||
| --   initCnt = if showProgress then 0 else -1 | ||||
| --   put line pers (-1) = do when pers (hPutStrLn handle line); return (-1) | ||||
| --   put line True  cnt = do hPutStrLn handle (erase cnt ++ line); return 0 | ||||
| --   put line False _   = do hPutStr handle ('\n' : line); return (length line) | ||||
| --     -- The "erasing" strategy with a single '\r' relies on the fact that the | ||||
| --     -- lengths of successive summary lines are monotonically nondecreasing. | ||||
| --   erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r" | ||||
| 
 | ||||
|  | ||||
| @ -2,7 +2,7 @@ | ||||
| -- | ||||
| -- see: https://github.com/sol/hpack | ||||
| -- | ||||
| -- hash: afb7a8b69691588056deb8465bec29cc05326218651e83f7f47d169e4c46aa95 | ||||
| -- hash: b52d450888004e007b3689cfe42d916ab8e8af3bc91a6a374ff022a719e86611 | ||||
| 
 | ||||
| name:           hledger-lib | ||||
| version:        1.10.99 | ||||
| @ -117,6 +117,7 @@ library | ||||
|     , data-default >=0.5 | ||||
|     , deepseq | ||||
|     , directory | ||||
|     , easytest | ||||
|     , extra | ||||
|     , filepath | ||||
|     , hashtables >=1.2.3.1 | ||||
| @ -215,6 +216,7 @@ test-suite doctests | ||||
|     , deepseq | ||||
|     , directory | ||||
|     , doctest >=0.8 | ||||
|     , easytest | ||||
|     , extra | ||||
|     , filepath | ||||
|     , hashtables >=1.2.3.1 | ||||
| @ -411,6 +413,7 @@ test-suite hunittests | ||||
|     , data-default >=0.5 | ||||
|     , deepseq | ||||
|     , directory | ||||
|     , easytest | ||||
|     , extra | ||||
|     , filepath | ||||
|     , hashtables >=1.2.3.1 | ||||
|  | ||||
| @ -52,6 +52,7 @@ dependencies: | ||||
| - Decimal | ||||
| - deepseq | ||||
| - directory | ||||
| - easytest | ||||
| - filepath | ||||
| - hashtables >=1.2.3.1 | ||||
| - megaparsec >=6.4.1 | ||||
| @ -177,4 +178,3 @@ tests: | ||||
|     source-dirs: tests | ||||
|     dependencies: | ||||
|     - hledger-lib | ||||
|     - easytest | ||||
|  | ||||
| @ -3,7 +3,6 @@ hledger's built-in commands, and helpers for printing the commands list. | ||||
| -} | ||||
| 
 | ||||
| {-# LANGUAGE OverloadedStrings #-} | ||||
| {-# LANGUAGE ScopedTypeVariables #-} | ||||
| {-# LANGUAGE QuasiQuotes #-} | ||||
| {-# LANGUAGE CPP #-} | ||||
| 
 | ||||
| @ -38,7 +37,6 @@ module Hledger.Cli.Commands ( | ||||
| where | ||||
| 
 | ||||
| -- import Control.Concurrent | ||||
| import Control.Exception | ||||
| import Control.Monad | ||||
| import Data.Default | ||||
| -- import Data.CallStack | ||||
| @ -53,9 +51,7 @@ import qualified Data.Text as T | ||||
| import Data.Time.Calendar | ||||
| import System.Console.CmdArgs.Explicit as C | ||||
| import System.Exit | ||||
| import System.IO (stdout) | ||||
| import EasyTest | ||||
| import Test.HUnit | ||||
| import Test.HUnit as HUnit | ||||
| 
 | ||||
| import Hledger | ||||
| import Hledger.Cli.CliOptions | ||||
| @ -219,141 +215,46 @@ commandsFromCommandsList s = | ||||
|   concatMap (splitOn "|") [w | ' ':l <- lines s, let w:_ = words l] | ||||
| 
 | ||||
| 
 | ||||
| -- The test command, defined here for easy access to other modules' tests. | ||||
| 
 | ||||
| -- The test command, defined here so it can access other commands' tests. | ||||
| testmode = hledgerCommandMode | ||||
|   [here| test | ||||
| Run the unit tests built in to hledger-lib and hledger,  | ||||
| printing results on stdout and exiting with success or failure. | ||||
| 
 | ||||
| testmode = (defCommandMode ["test"]) { | ||||
|   modeHelp = "run built-in self-tests" | ||||
|  ,modeArgs = ([], Just $ argsFlag "[REGEXPS]") | ||||
|  ,modeGroupFlags = Group { | ||||
|      groupUnnamed = [] | ||||
|     ,groupHidden = [ | ||||
|         flagNone ["tree"] (\opts -> setboolopt "tree" opts) "show tests hierarchically" | ||||
|        ,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show tests as a flat list" | ||||
|       ] | ||||
|     ,groupNamed = [generalflagsgroup3] | ||||
|     } | ||||
|  } | ||||
| Tests are run in two batches: easytest-based and hunit-based tests. | ||||
| If any test fails or gives an error, the exit code will be non-zero. | ||||
| 
 | ||||
| -- | Run some or all hledger-lib and hledger unit tests, and exit with success or failure. | ||||
| If a pattern argument (case sensitive) is provided, only easytests  | ||||
| in that scope and only hunit tests whose name contains it are run. | ||||
| 
 | ||||
| If a numeric second argument is provided, it will set the randomness | ||||
| seed for easytests.  | ||||
| 
 | ||||
| FLAGS | ||||
|   |] | ||||
|   [] | ||||
|   [generalflagsgroup3] | ||||
|   [] | ||||
|   ([], Just $ argsFlag "[TESTPATTERN] [SEED]") | ||||
| 
 | ||||
| -- | See testmode. | ||||
| -- | ||||
| -- Unlike other hledger commands, this one does not operate on the user's Journal. | ||||
| -- For ease of implementation the Journal parameter remains in the type signature,  | ||||
| -- but it will raise an error if used. | ||||
| -- For ease of implementation the Journal parameter remains in the type signature.  | ||||
| testcmd :: CliOpts -> Journal -> IO () | ||||
| testcmd opts _donotuse = do | ||||
| testcmd opts _undefined = do  | ||||
|   let args = words' $ query_ $ reportopts_ opts | ||||
|   putStrLn "\n=== easytest tests: ===\n" | ||||
|   runEasyTests opts | ||||
| 
 | ||||
|   putStrLn "\n\n=== hunit tests: ===\n" | ||||
|   runHunitTests opts | ||||
|     -- hide exit exception output when running tests from ghci/ghcid | ||||
|     `catch` (\(_::ExitCode) -> return ()) | ||||
| 
 | ||||
|   -- whitespace to separate test results from ghcid status | ||||
|   e1 <- runEasyTests args easytests | ||||
|   when (not e1) $ putStr "\n" | ||||
|   putStrLn "=== hunit tests: ===\n" | ||||
|   e2 <- runHunitTests args tests_Hledger_Cli_Commands | ||||
|   putStrLn "" | ||||
|   if or [e1, e2] then exitFailure else exitSuccess | ||||
| 
 | ||||
| -- | Run some easytests. | ||||
| -- XXX Just duplicates the ones in hledger-lib/tests/easytest.hs for now. | ||||
| runEasyTests _opts = do | ||||
|   run | ||||
|   -- rerun "journal.standard account types.queries.assets" | ||||
|   -- rerunOnly 2686786430487349354 "journal.standard account types.queries.assets" | ||||
|     $ tests [ | ||||
| -- collected hledger-lib + hledger hunit tests | ||||
| 
 | ||||
|       scope "journal.standard account types.queries" $ | ||||
|         let | ||||
|           j = samplejournal | ||||
|           journalAccountNamesMatching :: Query -> Journal -> [AccountName] | ||||
|           journalAccountNamesMatching q = filter (q `matchesAccount`) . journalAccountNames | ||||
|           namesfrom qfunc = journalAccountNamesMatching (qfunc j) j | ||||
|         in | ||||
|           tests | ||||
|             [ scope "assets" $ | ||||
|               expectEq (namesfrom journalAssetAccountQuery)     ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"] | ||||
|             , scope "liabilities" $ | ||||
|               expectEq (namesfrom journalLiabilityAccountQuery) ["liabilities","liabilities:debts"] | ||||
|             , scope "equity" $ | ||||
|               expectEq (namesfrom journalEquityAccountQuery)    [] | ||||
|             , scope "income" $ | ||||
|               expectEq (namesfrom journalIncomeAccountQuery)    ["income","income:gifts","income:salary"] | ||||
|             , scope "expenses" $ | ||||
|               expectEq (namesfrom journalExpenseAccountQuery)   ["expenses","expenses:food","expenses:supplies"] | ||||
|             ] | ||||
| 
 | ||||
|     ] | ||||
| 
 | ||||
| runHunitTests opts = do | ||||
|   let ts =  | ||||
|         (if tree_ $ reportopts_ opts then matchedTestsTree else matchedTestsFlat)  | ||||
|           opts tests_Hledger_Cli_Commands | ||||
|   results <- liftM (fst . flip (,) 0) $ runTestTTStdout ts | ||||
|   if errors results > 0 || failures results > 0 | ||||
|     then exitFailure | ||||
|     else exitWith ExitSuccess | ||||
| 
 | ||||
| -- | Like runTestTT but prints to stdout. | ||||
| runTestTTStdout t = do | ||||
|   (counts, 0) <- runTestText (putTextToHandle stdout True) t | ||||
|   return counts | ||||
| 
 | ||||
| -- -- | Like runTestTT but can optionally not erase progress output. | ||||
| -- runTestTT' verbose t = do | ||||
| --   (counts, 0) <- runTestText' (f stderr True) t | ||||
| --   return counts | ||||
| --   where f | verbose   = putTextToHandle' | ||||
| --           | otherwise = putTextToHandle | ||||
| 
 | ||||
| -- -- | Like runTestText but also prints test names if any. | ||||
| -- runTestText' :: PutText st -> Test -> IO (Counts, st) | ||||
| -- runTestText' _pt _t@(TestLabel _label _) = error "HERE"  -- hPutStrLn stderr label >> runTestText pt t | ||||
| -- runTestText' pt t = runTestText pt t | ||||
| 
 | ||||
| -- -- runTestText' (PutText put us0) t = do | ||||
| -- --   (counts', us1) <- trace "XXX" $ performTest reportStart reportError reportFailure us0 t | ||||
| -- --   us2 <- put (showCounts counts' ++ " :::: " ++ testName t) True us1 | ||||
| -- --   return (counts', us2) | ||||
| -- --  where | ||||
| -- --   reportStart ss us = put (showCounts (counts ss)) False us | ||||
| -- --   reportError   = reportProblem "Error:"   "Error in:   " | ||||
| -- --   reportFailure = reportProblem "Failure:" "Failure in: " | ||||
| -- --   reportProblem p0 p1 loc msg ss us = put line True us | ||||
| -- --    where line  = "### " ++ kind ++ path' ++ "\n" ++ formatLocation loc ++ msg | ||||
| -- --          kind  = if null path' then p0 else p1 | ||||
| -- --          path' = showPath (path ss) | ||||
| 
 | ||||
| -- -- formatLocation :: Maybe SrcLoc -> String | ||||
| -- -- formatLocation Nothing = "" | ||||
| -- -- formatLocation (Just loc) = srcLocFile loc ++ ":" ++ show (srcLocStartLine loc) ++ "\n" | ||||
| 
 | ||||
| -- -- | Like putTextToHandle but does not erase progress lines. | ||||
| -- putTextToHandle' | ||||
| --     :: Handle | ||||
| --     -> Bool -- ^ Write progress lines to handle? | ||||
| --     -> PutText Int | ||||
| -- putTextToHandle' handle showProgress = PutText put initCnt | ||||
| --  where | ||||
| --   initCnt = if showProgress then 0 else -1 | ||||
| --   put line pers (-1) = do when pers (hPutStrLn handle line); return (-1) | ||||
| --   put line True  cnt = do hPutStrLn handle (erase cnt ++ line); return 0 | ||||
| --   put line False _   = do hPutStr handle ('\n' : line); return (length line) | ||||
| --     -- The "erasing" strategy with a single '\r' relies on the fact that the | ||||
| --     -- lengths of successive summary lines are monotonically nondecreasing. | ||||
| --   erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r" | ||||
| 
 | ||||
| -- | All or pattern-matched tests, as a flat list to show simple names. | ||||
| matchedTestsFlat opts = TestList .  | ||||
|   filter (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . T.pack . testName) .  | ||||
|   flattenTests | ||||
| 
 | ||||
| -- | All or pattern-matched tests, in the original suites to show hierarchical names. | ||||
| matchedTestsTree opts =  | ||||
|   filterTests (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . T.pack . testName)  | ||||
| 
 | ||||
| 
 | ||||
| -- collected hledger-lib + hledger unit tests | ||||
| 
 | ||||
| tests_Hledger_Cli_Commands :: Test.HUnit.Test | ||||
| tests_Hledger_Cli_Commands = TestList [ | ||||
|    tests_Hledger | ||||
|   ,tests_Hledger_Cli_CliOptions | ||||
|  | ||||
| @ -787,14 +787,20 @@ With additional QUERY arguments, only transactions matching the query are consid | ||||
| ## test | ||||
| Run built-in unit tests. | ||||
| 
 | ||||
| ```shell | ||||
| $ hledger test | ||||
| Cases: 74  Tried: 74  Errors: 0  Failures: 0 | ||||
| ``` | ||||
| 
 | ||||
| This command runs hledger's built-in unit tests and displays a quick report. | ||||
| With a regular expression argument, it selects only tests with matching names. | ||||
| It's mainly used in development, but it's also nice to be able to | ||||
| check your hledger executable for smoke at any time. | ||||
| It's mainly used during development, but it's also nice to be able to | ||||
| sanity-check your installed hledger executable at any time. | ||||
| 
 | ||||
| It runs the unit tests built in to hledger-lib and hledger,  | ||||
| printing results on stdout and exiting with success or failure. | ||||
| 
 | ||||
| Tests are run in two batches: easytest-based and hunit-based tests. | ||||
| If any test fails or gives an error, the exit code will be non-zero. | ||||
| 
 | ||||
| If a pattern argument (case sensitive) is provided, only easytests  | ||||
| in that scope and only hunit tests whose name contains it are run. | ||||
| 
 | ||||
| If a numeric second argument is provided, it will set the randomness | ||||
| seed for easytests.  | ||||
| 
 | ||||
| _include_(hledger_addons.m4.md) | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user