lib: drop HUnit helpers, rename expectEqPP

This commit is contained in:
Simon Michael 2018-09-04 13:52:36 -07:00
parent 54db19e857
commit 4003264129
17 changed files with 27 additions and 146 deletions

View File

@ -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" []]

View File

@ -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" [

View File

@ -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" $

View File

@ -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" [

View File

@ -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" [

View File

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

View File

@ -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" [

View File

@ -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" [

View File

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

View File

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

View File

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

View File

@ -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" $

View File

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

View File

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

View File

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

View File

@ -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" [

View File

@ -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" [