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 Hledger.Data.Types
import Hledger.Utils hiding (is)
import Hledger.Utils
-- $setup
-- >>> :set -XOverloadedStrings
@ -226,9 +226,6 @@ accountRegexToAccountName = T.pack . regexReplace "^\\^(.*?)\\(:\\|\\$\\)$" "\\1
--isAccountRegex :: String -> Bool
--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" [
tests "accountNameTreeFrom" [
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.Commodity
import Hledger.Utils hiding (is)
import Hledger.Utils
deriving instance Show MarketPrice
@ -671,9 +671,6 @@ mixedAmountValue j d (Mixed as) = Mixed $ map (amountValue j d) as
-------------------------------------------------------------------------------
-- tests
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
is = flip expectEq'
easytests_Amount = tests "Amount" [
tests "Amount" [

View File

@ -97,7 +97,7 @@ import System.Time (ClockTime(TOD))
import Text.Printf
import qualified Data.Map as M
import Hledger.Utils hiding (is)
import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.AccountName
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" [
test "journalDateSpan" $

View File

@ -31,7 +31,7 @@ import qualified Data.Text as T
import Safe (headDef)
import Text.Printf
import Hledger.Utils.Test hiding (is)
import Hledger.Utils.Test
import Hledger.Data.Types
import Hledger.Data.Account
import Hledger.Data.Journal
@ -107,9 +107,6 @@ ledgerCommodities = M.keys . jinferredcommodities . ljournal
-- tests
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
is = flip expectEq'
easytests_Ledger = tests "Ledger" [
tests "ledgerFromJournal" [

View File

@ -69,7 +69,7 @@ import qualified Data.Text as T
import Data.Time.Calendar
import Safe
import Hledger.Utils hiding (is)
import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.Amount
import Hledger.Data.AccountName
@ -293,9 +293,6 @@ aliasReplace (RegexAlias re repl) a = T.pack $ regexReplaceCIMemo re repl $ T.un
-- tests
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
is = flip expectEq'
easytests_Posting = tests "Posting" [
tests "accountNamePostingType" [

View File

@ -26,7 +26,7 @@ import System.Locale (defaultTimeLocale)
#endif
import Text.Printf
import Hledger.Utils hiding (is)
import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.Dates
import Hledger.Data.Amount
@ -113,9 +113,6 @@ entryFromTimeclockInOut i o
-- tests
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
is = flip expectEq'
easytests_Timeclock = tests "Timeclock" [
do
today <- io getCurrentDay

View File

@ -56,7 +56,7 @@ import Data.Time.Calendar
import Text.Printf
import qualified Data.Map as Map
import Hledger.Utils hiding (is)
import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.Dates
import Hledger.Data.Posting
@ -442,9 +442,6 @@ postingSetTransaction t p = p{ptransaction=Just t}
-- tests
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
is = flip expectEq'
easytests_Transaction = tests "Transaction" [
tests "showTransactionUnelided" [

View File

@ -63,7 +63,7 @@ import Safe (readDef, headDef)
import Text.Megaparsec
import Text.Megaparsec.Char
import Hledger.Utils hiding (words', is)
import Hledger.Utils hiding (words')
import Hledger.Data.Types
import Hledger.Data.AccountName
import Hledger.Data.Amount (nullamt, usd)
@ -652,9 +652,6 @@ matchesMarketPrice _ _ = True
-- tests
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
is = flip expectEq'
easytests_Query = tests "Query" [
tests "simplifyQuery" [

View File

@ -32,7 +32,7 @@ import Data.Time.Calendar
import Hledger.Data
import Hledger.Read (mamountp')
import Hledger.Query
import Hledger.Utils hiding (is)
import Hledger.Utils
import Hledger.Reports.ReportOptions
@ -180,9 +180,6 @@ Right samplejournal2 =
-- tests
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
is = flip expectEq'
easytests_BalanceReport = tests "BalanceReport" [
tests "balanceReport" $
let

View File

@ -20,7 +20,7 @@ import Data.Ord
import Hledger.Data
import Hledger.Query
import Hledger.Reports.ReportOptions
import Hledger.Utils hiding (is)
import Hledger.Utils
-- | A journal entries report is a list of whole transactions as
@ -37,9 +37,6 @@ entriesReport opts q j =
date = transactionDateFn opts
ts = jtxns $ journalSelectingAmountFromOpts opts j
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
is = flip expectEq'
easytests_EntriesReport = tests "EntriesReport" [
tests "entriesReport" [
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.Query
import Hledger.Utils hiding (is)
import Hledger.Utils
import Hledger.Read (mamountp')
import Hledger.Reports.ReportOptions
import Hledger.Reports.BalanceReport
@ -302,9 +302,6 @@ tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell =
-- tests
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
is = flip expectEq'
easytests_MultiBalanceReports = tests "MultiBalanceReports" [
let
(opts,journal) `gives` r = do

View File

@ -26,7 +26,7 @@ import Safe (headMay, lastMay)
import Hledger.Data
import Hledger.Query
import Hledger.Utils hiding (is)
import Hledger.Utils
import Hledger.Reports.ReportOptions
@ -217,9 +217,6 @@ summarisePostingsInDateSpan (DateSpan b e) wd depth showempty ps
-- tests
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
is = flip expectEq'
easytests_PostingsReport = tests "PostingsReport" [
tests "postingsReport" $

View File

@ -52,7 +52,7 @@ import Text.Megaparsec.Error
import Hledger.Data
import Hledger.Query
import Hledger.Utils hiding (is)
import Hledger.Utils
type FormatStr = String
@ -420,9 +420,6 @@ specifiedEndDate ropts = snd <$> specifiedStartEndDates ropts
-- tests
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
is = flip expectEq'
easytests_ReportOptions = tests "ReportOptions" [
tests "queryFromOpts" [
(queryFromOpts nulldate defreportopts) `is` Any

View File

@ -3,7 +3,6 @@
{-# LANGUAGE ScopedTypeVariables #-}
module Hledger.Utils.Test (
-- * easytest
HasCallStack
,module EasyTest
,runEasyTests
@ -13,42 +12,30 @@ module Hledger.Utils.Test (
,_test
,it
,_it
,expectEq'
,is
,expectEqPP
,expectParse
,expectParseError
,expectParseEq
,expectParseEqOn
-- * HUnit
,module Test.HUnit
,runHunitTests
,assertParse
,assertParseFailure
,assertParseEqual
,assertParseEqual'
,is
) where
)
where
import Control.Exception
import Control.Monad
import Control.Monad.State.Strict (StateT, evalStateT)
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import Data.CallStack
import Data.Functor.Identity
import Data.List
import qualified Data.Text as T
import Safe
import System.Exit
import System.IO
import Text.Megaparsec
import Text.Megaparsec.Custom
import EasyTest hiding (char, char', tests) -- reexported
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.UTF8IOCompat (error')
@ -102,10 +89,14 @@ runEasyTests args easytests = (do
-- | Like easytest's expectEq (asserts the second (actual) value equals the first (expected) value)
-- but pretty-prints the values in the failure output.
expectEq' :: (Eq a, Show a, HasCallStack) => a -> a -> E.Test ()
expectEq' expected actual = if expected == actual then E.ok else E.crash $
expectEqPP :: (Eq a, Show a, HasCallStack) => a -> a -> E.Test ()
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"
-- | 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
-- all of the given input text, showing the parse error if it fails.
-- 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 ()
expectParseEqOn parser input f expected = do
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.Exit
import Hledger hiding (is)
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Version
import Hledger.Cli.Commands.Accounts
@ -245,9 +245,6 @@ testcmd opts _undefined = do
-- unit tests of hledger command-line executable
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
is = flip expectEq'
easytests_Commands = tests "Commands" [
easytests_Balance
,easytests_Register

View File

@ -263,7 +263,7 @@ import Text.Printf (printf)
import Text.Tabular as T
--import Text.Tabular.AsciiWide
import Hledger hiding (is)
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
@ -630,9 +630,6 @@ balanceReportTableAsText ropts = tableAsText ropts showamt
| otherwise = showMixedAmountOneLineWithoutPrice
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
is = flip expectEq'
easytests_Balance = tests "Balance" [
tests "balanceReportAsText" [

View File

@ -22,7 +22,7 @@ import qualified Data.Text as T
import System.Console.CmdArgs.Explicit
import Text.CSV
import Hledger hiding (is)
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
@ -191,9 +191,6 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
-- tests
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
is = flip expectEq'
easytests_Register = tests "Register" [
tests "postingsReportAsText" [