lib: drop HUnit helpers, rename expectEqPP
This commit is contained in:
		
							parent
							
								
									54db19e857
								
							
						
					
					
						commit
						4003264129
					
				| @ -50,7 +50,7 @@ import Data.Tree | |||||||
| import Text.Printf | import Text.Printf | ||||||
| 
 | 
 | ||||||
| import Hledger.Data.Types | import Hledger.Data.Types | ||||||
| import Hledger.Utils hiding (is) | import Hledger.Utils  | ||||||
| 
 | 
 | ||||||
| -- $setup | -- $setup | ||||||
| -- >>> :set -XOverloadedStrings | -- >>> :set -XOverloadedStrings | ||||||
| @ -226,9 +226,6 @@ accountRegexToAccountName = T.pack . regexReplace "^\\^(.*?)\\(:\\|\\$\\)$" "\\1 | |||||||
| --isAccountRegex  :: String -> Bool | --isAccountRegex  :: String -> Bool | ||||||
| --isAccountRegex s = take 1 s == "^" && take 5 (reverse s) == ")$|:(" | --isAccountRegex s = take 1 s == "^" && take 5 (reverse s) == ")$|:(" | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_AccountName = tests "AccountName" [ | easytests_AccountName = tests "AccountName" [ | ||||||
|   tests "accountNameTreeFrom" [ |   tests "accountNameTreeFrom" [ | ||||||
|      accountNameTreeFrom ["a"]       `is` Node "root" [Node "a" []] |      accountNameTreeFrom ["a"]       `is` Node "root" [Node "a" []] | ||||||
|  | |||||||
| @ -133,7 +133,7 @@ import qualified Data.Map as M | |||||||
| 
 | 
 | ||||||
| import Hledger.Data.Types | import Hledger.Data.Types | ||||||
| import Hledger.Data.Commodity | import Hledger.Data.Commodity | ||||||
| import Hledger.Utils hiding (is) | import Hledger.Utils  | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| deriving instance Show MarketPrice | deriving instance Show MarketPrice | ||||||
| @ -671,9 +671,6 @@ mixedAmountValue j d (Mixed as) = Mixed $ map (amountValue j d) as | |||||||
| ------------------------------------------------------------------------------- | ------------------------------------------------------------------------------- | ||||||
| -- tests | -- tests | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_Amount = tests "Amount" [ | easytests_Amount = tests "Amount" [ | ||||||
|    tests "Amount" [ |    tests "Amount" [ | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -97,7 +97,7 @@ import System.Time (ClockTime(TOD)) | |||||||
| import Text.Printf | import Text.Printf | ||||||
| import qualified Data.Map as M | import qualified Data.Map as M | ||||||
| 
 | 
 | ||||||
| import Hledger.Utils hiding (is) | import Hledger.Utils  | ||||||
| import Hledger.Data.Types | import Hledger.Data.Types | ||||||
| import Hledger.Data.AccountName | import Hledger.Data.AccountName | ||||||
| import Hledger.Data.Amount | import Hledger.Data.Amount | ||||||
| @ -1060,9 +1060,6 @@ Right samplejournal = journalBalanceTransactions False $ | |||||||
|           ] |           ] | ||||||
|          } |          } | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_Journal = tests "Journal" [ | easytests_Journal = tests "Journal" [ | ||||||
| 
 | 
 | ||||||
|    test "journalDateSpan" $ |    test "journalDateSpan" $ | ||||||
|  | |||||||
| @ -31,7 +31,7 @@ import qualified Data.Text as T | |||||||
| import Safe (headDef) | import Safe (headDef) | ||||||
| import Text.Printf | import Text.Printf | ||||||
| 
 | 
 | ||||||
| import Hledger.Utils.Test hiding (is) | import Hledger.Utils.Test  | ||||||
| import Hledger.Data.Types | import Hledger.Data.Types | ||||||
| import Hledger.Data.Account | import Hledger.Data.Account | ||||||
| import Hledger.Data.Journal | import Hledger.Data.Journal | ||||||
| @ -107,9 +107,6 @@ ledgerCommodities = M.keys . jinferredcommodities . ljournal | |||||||
| 
 | 
 | ||||||
| -- tests | -- tests | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_Ledger = tests "Ledger" [ | easytests_Ledger = tests "Ledger" [ | ||||||
| 
 | 
 | ||||||
|   tests "ledgerFromJournal" [ |   tests "ledgerFromJournal" [ | ||||||
|  | |||||||
| @ -69,7 +69,7 @@ import qualified Data.Text as T | |||||||
| import Data.Time.Calendar | import Data.Time.Calendar | ||||||
| import Safe | import Safe | ||||||
| 
 | 
 | ||||||
| import Hledger.Utils hiding (is) | import Hledger.Utils  | ||||||
| import Hledger.Data.Types | import Hledger.Data.Types | ||||||
| import Hledger.Data.Amount | import Hledger.Data.Amount | ||||||
| import Hledger.Data.AccountName | import Hledger.Data.AccountName | ||||||
| @ -293,9 +293,6 @@ aliasReplace (RegexAlias re repl) a = T.pack $ regexReplaceCIMemo re repl $ T.un | |||||||
| 
 | 
 | ||||||
| -- tests | -- tests | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_Posting = tests "Posting" [ | easytests_Posting = tests "Posting" [ | ||||||
| 
 | 
 | ||||||
|   tests "accountNamePostingType" [ |   tests "accountNamePostingType" [ | ||||||
|  | |||||||
| @ -26,7 +26,7 @@ import System.Locale (defaultTimeLocale) | |||||||
| #endif | #endif | ||||||
| import Text.Printf | import Text.Printf | ||||||
| 
 | 
 | ||||||
| import Hledger.Utils hiding (is) | import Hledger.Utils  | ||||||
| import Hledger.Data.Types | import Hledger.Data.Types | ||||||
| import Hledger.Data.Dates | import Hledger.Data.Dates | ||||||
| import Hledger.Data.Amount | import Hledger.Data.Amount | ||||||
| @ -113,9 +113,6 @@ entryFromTimeclockInOut i o | |||||||
| 
 | 
 | ||||||
| -- tests | -- tests | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_Timeclock = tests "Timeclock" [ | easytests_Timeclock = tests "Timeclock" [ | ||||||
|   do |   do | ||||||
|    today <- io getCurrentDay |    today <- io getCurrentDay | ||||||
|  | |||||||
| @ -56,7 +56,7 @@ import Data.Time.Calendar | |||||||
| import Text.Printf | import Text.Printf | ||||||
| import qualified Data.Map as Map | import qualified Data.Map as Map | ||||||
| 
 | 
 | ||||||
| import Hledger.Utils hiding (is) | import Hledger.Utils  | ||||||
| import Hledger.Data.Types | import Hledger.Data.Types | ||||||
| import Hledger.Data.Dates | import Hledger.Data.Dates | ||||||
| import Hledger.Data.Posting | import Hledger.Data.Posting | ||||||
| @ -442,9 +442,6 @@ postingSetTransaction t p = p{ptransaction=Just t} | |||||||
| 
 | 
 | ||||||
| -- tests | -- tests | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_Transaction = tests "Transaction" [ | easytests_Transaction = tests "Transaction" [ | ||||||
| 
 | 
 | ||||||
|   tests "showTransactionUnelided" [ |   tests "showTransactionUnelided" [ | ||||||
|  | |||||||
| @ -63,7 +63,7 @@ import Safe (readDef, headDef) | |||||||
| import Text.Megaparsec | import Text.Megaparsec | ||||||
| import Text.Megaparsec.Char | import Text.Megaparsec.Char | ||||||
| 
 | 
 | ||||||
| import Hledger.Utils hiding (words', is) | import Hledger.Utils hiding (words') | ||||||
| import Hledger.Data.Types | import Hledger.Data.Types | ||||||
| import Hledger.Data.AccountName | import Hledger.Data.AccountName | ||||||
| import Hledger.Data.Amount (nullamt, usd) | import Hledger.Data.Amount (nullamt, usd) | ||||||
| @ -652,9 +652,6 @@ matchesMarketPrice _ _           = True | |||||||
| 
 | 
 | ||||||
| -- tests | -- tests | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_Query = tests "Query" [ | easytests_Query = tests "Query" [ | ||||||
|    tests "simplifyQuery" [ |    tests "simplifyQuery" [ | ||||||
|      |      | ||||||
|  | |||||||
| @ -32,7 +32,7 @@ import Data.Time.Calendar | |||||||
| import Hledger.Data | import Hledger.Data | ||||||
| import Hledger.Read (mamountp') | import Hledger.Read (mamountp') | ||||||
| import Hledger.Query | import Hledger.Query | ||||||
| import Hledger.Utils hiding (is) | import Hledger.Utils  | ||||||
| import Hledger.Reports.ReportOptions | import Hledger.Reports.ReportOptions | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| @ -180,9 +180,6 @@ Right samplejournal2 = | |||||||
| 
 | 
 | ||||||
| -- tests | -- tests | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_BalanceReport = tests "BalanceReport" [ | easytests_BalanceReport = tests "BalanceReport" [ | ||||||
|   tests "balanceReport" $ |   tests "balanceReport" $ | ||||||
|     let |     let | ||||||
|  | |||||||
| @ -20,7 +20,7 @@ import Data.Ord | |||||||
| import Hledger.Data | import Hledger.Data | ||||||
| import Hledger.Query | import Hledger.Query | ||||||
| import Hledger.Reports.ReportOptions | import Hledger.Reports.ReportOptions | ||||||
| import Hledger.Utils hiding (is) | import Hledger.Utils  | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| -- | A journal entries report is a list of whole transactions as | -- | A journal entries report is a list of whole transactions as | ||||||
| @ -37,9 +37,6 @@ entriesReport opts q j = | |||||||
|       date = transactionDateFn opts |       date = transactionDateFn opts | ||||||
|       ts = jtxns $ journalSelectingAmountFromOpts opts j |       ts = jtxns $ journalSelectingAmountFromOpts opts j | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_EntriesReport = tests "EntriesReport" [ | easytests_EntriesReport = tests "EntriesReport" [ | ||||||
|   tests "entriesReport" [ |   tests "entriesReport" [ | ||||||
|      test "not acct" $ (length $ entriesReport defreportopts (Not $ Acct "bank") samplejournal) `is` 1 |      test "not acct" $ (length $ entriesReport defreportopts (Not $ Acct "bank") samplejournal) `is` 1 | ||||||
|  | |||||||
| @ -30,7 +30,7 @@ import Text.Tabular.AsciiWide | |||||||
| 
 | 
 | ||||||
| import Hledger.Data | import Hledger.Data | ||||||
| import Hledger.Query | import Hledger.Query | ||||||
| import Hledger.Utils hiding (is) | import Hledger.Utils  | ||||||
| import Hledger.Read (mamountp') | import Hledger.Read (mamountp') | ||||||
| import Hledger.Reports.ReportOptions | import Hledger.Reports.ReportOptions | ||||||
| import Hledger.Reports.BalanceReport | import Hledger.Reports.BalanceReport | ||||||
| @ -302,9 +302,6 @@ tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell = | |||||||
| 
 | 
 | ||||||
| -- tests | -- tests | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_MultiBalanceReports = tests "MultiBalanceReports" [ | easytests_MultiBalanceReports = tests "MultiBalanceReports" [ | ||||||
|   let |   let | ||||||
|     (opts,journal) `gives` r = do |     (opts,journal) `gives` r = do | ||||||
|  | |||||||
| @ -26,7 +26,7 @@ import Safe (headMay, lastMay) | |||||||
| 
 | 
 | ||||||
| import Hledger.Data | import Hledger.Data | ||||||
| import Hledger.Query | import Hledger.Query | ||||||
| import Hledger.Utils hiding (is) | import Hledger.Utils  | ||||||
| import Hledger.Reports.ReportOptions | import Hledger.Reports.ReportOptions | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| @ -217,9 +217,6 @@ summarisePostingsInDateSpan (DateSpan b e) wd depth showempty ps | |||||||
| 
 | 
 | ||||||
| -- tests | -- tests | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_PostingsReport = tests "PostingsReport" [ | easytests_PostingsReport = tests "PostingsReport" [ | ||||||
| 
 | 
 | ||||||
|    tests "postingsReport" $ |    tests "postingsReport" $ | ||||||
|  | |||||||
| @ -52,7 +52,7 @@ import Text.Megaparsec.Error | |||||||
| 
 | 
 | ||||||
| import Hledger.Data | import Hledger.Data | ||||||
| import Hledger.Query | import Hledger.Query | ||||||
| import Hledger.Utils hiding (is) | import Hledger.Utils | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| type FormatStr = String | type FormatStr = String | ||||||
| @ -420,9 +420,6 @@ specifiedEndDate ropts = snd <$> specifiedStartEndDates ropts | |||||||
| 
 | 
 | ||||||
| -- tests | -- tests | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_ReportOptions = tests "ReportOptions" [ | easytests_ReportOptions = tests "ReportOptions" [ | ||||||
|    tests "queryFromOpts" [ |    tests "queryFromOpts" [ | ||||||
|       (queryFromOpts nulldate defreportopts) `is` Any |       (queryFromOpts nulldate defreportopts) `is` Any | ||||||
|  | |||||||
| @ -3,7 +3,6 @@ | |||||||
| {-# LANGUAGE ScopedTypeVariables #-} | {-# LANGUAGE ScopedTypeVariables #-} | ||||||
| 
 | 
 | ||||||
| module Hledger.Utils.Test ( | module Hledger.Utils.Test ( | ||||||
|   -- * easytest |  | ||||||
|    HasCallStack |    HasCallStack | ||||||
|   ,module EasyTest |   ,module EasyTest | ||||||
|   ,runEasyTests |   ,runEasyTests | ||||||
| @ -13,42 +12,30 @@ module Hledger.Utils.Test ( | |||||||
|   ,_test |   ,_test | ||||||
|   ,it |   ,it | ||||||
|   ,_it |   ,_it | ||||||
|   ,expectEq' |   ,is | ||||||
|  |   ,expectEqPP | ||||||
|   ,expectParse |   ,expectParse | ||||||
|   ,expectParseError |   ,expectParseError | ||||||
|   ,expectParseEq |   ,expectParseEq | ||||||
|   ,expectParseEqOn |   ,expectParseEqOn | ||||||
|   -- * HUnit | )  | ||||||
|   ,module Test.HUnit | where | ||||||
|   ,runHunitTests |  | ||||||
|   ,assertParse |  | ||||||
|   ,assertParseFailure |  | ||||||
|   ,assertParseEqual |  | ||||||
|   ,assertParseEqual' |  | ||||||
|   ,is |  | ||||||
| 
 |  | ||||||
| ) where |  | ||||||
| 
 | 
 | ||||||
| import Control.Exception | import Control.Exception | ||||||
| import Control.Monad |  | ||||||
| import Control.Monad.State.Strict (StateT, evalStateT) | import Control.Monad.State.Strict (StateT, evalStateT) | ||||||
| #if !(MIN_VERSION_base(4,11,0)) | #if !(MIN_VERSION_base(4,11,0)) | ||||||
| import Data.Monoid ((<>)) | import Data.Monoid ((<>)) | ||||||
| #endif | #endif | ||||||
| import Data.CallStack | import Data.CallStack | ||||||
| import Data.Functor.Identity |  | ||||||
| import Data.List | import Data.List | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import Safe  | import Safe  | ||||||
| import System.Exit | import System.Exit | ||||||
| import System.IO |  | ||||||
| import Text.Megaparsec | import Text.Megaparsec | ||||||
| import Text.Megaparsec.Custom | import Text.Megaparsec.Custom | ||||||
| 
 | 
 | ||||||
| import EasyTest hiding (char, char', tests)  -- reexported | import EasyTest hiding (char, char', tests)  -- reexported | ||||||
| import qualified EasyTest as E               -- used here | import qualified EasyTest as E               -- used here | ||||||
| import Test.HUnit hiding (Test, test)        -- reexported |  | ||||||
| import qualified Test.HUnit as U             -- used here |  | ||||||
| 
 | 
 | ||||||
| import Hledger.Utils.Debug (pshow) | import Hledger.Utils.Debug (pshow) | ||||||
| import Hledger.Utils.UTF8IOCompat (error') | import Hledger.Utils.UTF8IOCompat (error') | ||||||
| @ -102,10 +89,14 @@ runEasyTests args easytests = (do | |||||||
| 
 | 
 | ||||||
| -- | Like easytest's expectEq (asserts the second (actual) value equals the first (expected) value) | -- | Like easytest's expectEq (asserts the second (actual) value equals the first (expected) value) | ||||||
| -- but pretty-prints the values in the failure output.  | -- but pretty-prints the values in the failure output.  | ||||||
| expectEq' :: (Eq a, Show a, HasCallStack) => a -> a -> E.Test () | expectEqPP :: (Eq a, Show a, HasCallStack) => a -> a -> E.Test () | ||||||
| expectEq' expected actual = if expected == actual then E.ok else E.crash $ | expectEqPP expected actual = if expected == actual then E.ok else E.crash $ | ||||||
|   "\nexpected:\n" <> T.pack (pshow expected) <> "\nbut got:\n" <> T.pack (pshow actual) <> "\n" |   "\nexpected:\n" <> T.pack (pshow expected) <> "\nbut got:\n" <> T.pack (pshow actual) <> "\n" | ||||||
| 
 | 
 | ||||||
|  | -- | Shorter and flipped version of expectEqPP. The expected value goes last. | ||||||
|  | is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () | ||||||
|  | is = flip expectEqPP | ||||||
|  | 
 | ||||||
| -- | Test that this stateful parser runnable in IO successfully parses  | -- | Test that this stateful parser runnable in IO successfully parses  | ||||||
| -- all of the given input text, showing the parse error if it fails.  | -- all of the given input text, showing the parse error if it fails.  | ||||||
| -- Suitable for hledger's JournalParser parsers. | -- Suitable for hledger's JournalParser parsers. | ||||||
| @ -141,67 +132,5 @@ expectParseEqOn :: (Monoid st, Eq b, Show b, HasCallStack) => | |||||||
|   StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> E.Test () |   StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> E.Test () | ||||||
| expectParseEqOn parser input f expected = do | expectParseEqOn parser input f expected = do | ||||||
|   ep <- E.io $ runParserT (evalStateT (parser <* eof) mempty) "" input |   ep <- E.io $ runParserT (evalStateT (parser <* eof) mempty) "" input | ||||||
|   either (fail . (++"\n") . ("\nparse error at "++) . parseErrorPretty) (expectEq' expected . f) ep |   either (fail . (++"\n") . ("\nparse error at "++) . parseErrorPretty) (expectEqPP expected . f) ep | ||||||
| 
 | 
 | ||||||
| -- * HUnit helpers |  | ||||||
| 
 |  | ||||||
| -- | Get a Test's label, or the empty string. |  | ||||||
| testName :: U.Test -> String |  | ||||||
| testName (TestLabel n _) = n |  | ||||||
| testName _ = "" |  | ||||||
| 
 |  | ||||||
| -- | Flatten a Test containing TestLists into a list of single tests. |  | ||||||
| flattenTests :: U.Test -> [U.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 :: (U.Test -> Bool) -> U.Test -> U.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 |  | ||||||
| 
 |  | ||||||
| -- | Simple way to assert something is some expected value, with no label. |  | ||||||
| is :: (Eq a, Show a) => a -> a -> Assertion |  | ||||||
| a `is` e = assertEqual "" e a  -- XXX should it have a message ? |  | ||||||
| 
 |  | ||||||
| -- | Assert a parse result is successful, printing the parse error on failure. |  | ||||||
| assertParse :: (Show t, Show e) => (Either (ParseError t e) a) -> Assertion |  | ||||||
| assertParse parse = either (assertFailure.show) (const (return ())) parse |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| -- | Assert a parse result is successful, printing the parse error on failure. |  | ||||||
| assertParseFailure :: (Either (ParseError t e) a) -> Assertion |  | ||||||
| assertParseFailure parse = either (const $ return ()) (const $ assertFailure "parse should not have succeeded") parse |  | ||||||
| 
 |  | ||||||
| -- | Assert a parse result is some expected value, printing the parse error on failure. |  | ||||||
| assertParseEqual :: (Show a, Eq a, Show t, Show e) => (Either (ParseError t e) a) -> a -> Assertion |  | ||||||
| assertParseEqual parse expected = either (assertFailure.show) (`is` expected) parse |  | ||||||
| 
 |  | ||||||
| -- | Assert that the parse result returned from an identity monad is some expected value, |  | ||||||
| -- on failure printing the parse error or differing values. |  | ||||||
| assertParseEqual' :: (Show a, Eq a, Show t, Show e) => Identity (Either (ParseError t e) a) -> a -> Assertion |  | ||||||
| assertParseEqual' parse expected =  |  | ||||||
|   either  |  | ||||||
|     (assertFailure . ("parse error: "++) . pshow)  |  | ||||||
|     (\actual -> assertEqual (unlines ["expected: " ++ show expected, " but got: " ++ show actual]) expected actual)  |  | ||||||
|     $ runIdentity parse |  | ||||||
| 
 |  | ||||||
| -- | 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] -> U.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) <- U.runTestText (putTextToHandle stdout True) t |  | ||||||
|       return counts |  | ||||||
|  | |||||||
| @ -51,7 +51,7 @@ import qualified EasyTest | |||||||
| import System.Console.CmdArgs.Explicit as C | import System.Console.CmdArgs.Explicit as C | ||||||
| import System.Exit | import System.Exit | ||||||
| 
 | 
 | ||||||
| import Hledger hiding (is) | import Hledger  | ||||||
| import Hledger.Cli.CliOptions | import Hledger.Cli.CliOptions | ||||||
| import Hledger.Cli.Version | import Hledger.Cli.Version | ||||||
| import Hledger.Cli.Commands.Accounts | import Hledger.Cli.Commands.Accounts | ||||||
| @ -245,9 +245,6 @@ testcmd opts _undefined = do | |||||||
| 
 | 
 | ||||||
| -- unit tests of hledger command-line executable | -- unit tests of hledger command-line executable | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_Commands = tests "Commands" [ | easytests_Commands = tests "Commands" [ | ||||||
|    easytests_Balance |    easytests_Balance | ||||||
|   ,easytests_Register |   ,easytests_Register | ||||||
|  | |||||||
| @ -263,7 +263,7 @@ import Text.Printf (printf) | |||||||
| import Text.Tabular as T | import Text.Tabular as T | ||||||
| --import Text.Tabular.AsciiWide | --import Text.Tabular.AsciiWide | ||||||
| 
 | 
 | ||||||
| import Hledger hiding (is) | import Hledger  | ||||||
| import Hledger.Cli.CliOptions | import Hledger.Cli.CliOptions | ||||||
| import Hledger.Cli.Utils | import Hledger.Cli.Utils | ||||||
| 
 | 
 | ||||||
| @ -630,9 +630,6 @@ balanceReportTableAsText ropts = tableAsText ropts showamt | |||||||
|             | otherwise    =  showMixedAmountOneLineWithoutPrice |             | otherwise    =  showMixedAmountOneLineWithoutPrice | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_Balance = tests "Balance" [ | easytests_Balance = tests "Balance" [ | ||||||
| 
 | 
 | ||||||
|    tests "balanceReportAsText" [ |    tests "balanceReportAsText" [ | ||||||
|  | |||||||
| @ -22,7 +22,7 @@ import qualified Data.Text as T | |||||||
| import System.Console.CmdArgs.Explicit | import System.Console.CmdArgs.Explicit | ||||||
| import Text.CSV | import Text.CSV | ||||||
| 
 | 
 | ||||||
| import Hledger hiding (is) | import Hledger  | ||||||
| import Hledger.Cli.CliOptions | import Hledger.Cli.CliOptions | ||||||
| import Hledger.Cli.Utils | import Hledger.Cli.Utils | ||||||
| 
 | 
 | ||||||
| @ -191,9 +191,6 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda | |||||||
| 
 | 
 | ||||||
| -- tests | -- tests | ||||||
| 
 | 
 | ||||||
| is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () |  | ||||||
| is = flip expectEq' |  | ||||||
| 
 |  | ||||||
| easytests_Register = tests "Register" [ | easytests_Register = tests "Register" [ | ||||||
| 
 | 
 | ||||||
|    tests "postingsReportAsText" [ |    tests "postingsReportAsText" [ | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user