test/_test/it/_it helpers; refactor easytests
This makes skipping/unskipping tests easier, and improves readability a bit. Note it's also possible to just write the test name with no preceding function, when the type is constrained (see Journal.hs).
This commit is contained in:
parent
626247bacd
commit
b4c336c874
@ -6,7 +6,7 @@ module Hledger (
|
||||
,Hledger.easytests
|
||||
)
|
||||
where
|
||||
import Test.HUnit
|
||||
import Test.HUnit hiding (test)
|
||||
import EasyTest
|
||||
|
||||
import Hledger.Data as X hiding (easytests)
|
||||
@ -26,7 +26,7 @@ tests_Hledger = TestList
|
||||
,tests_Hledger_Utils
|
||||
]
|
||||
|
||||
easytests = scope "Hledger" $ tests [
|
||||
easytests = test "Hledger" $ tests [
|
||||
Hledger.Data.easytests
|
||||
,Hledger.Read.easytests
|
||||
]
|
||||
|
||||
@ -97,7 +97,7 @@ import Safe (headMay, headDef)
|
||||
import Data.Time.Calendar
|
||||
import Data.Tree
|
||||
import System.Time (ClockTime(TOD))
|
||||
import Test.HUnit
|
||||
import Test.HUnit hiding (test)
|
||||
import Text.Printf
|
||||
import qualified Data.Map as M
|
||||
|
||||
@ -1088,23 +1088,18 @@ tests_Hledger_Data_Journal = TestList $
|
||||
-- journalProfitAndLossAccountNames j `is` ["expenses","expenses:e","income","income:i"]
|
||||
]
|
||||
|
||||
easytests = scope "Journal" $ tests [
|
||||
scope "standard account types" $ do
|
||||
easytests = test "Journal" $ tests [
|
||||
test "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"]
|
||||
[ "assets" $ expectEq (namesfrom journalAssetAccountQuery) ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]
|
||||
, "liabilities" $ expectEq (namesfrom journalLiabilityAccountQuery) ["liabilities","liabilities:debts"]
|
||||
, "equity" $ expectEq (namesfrom journalEquityAccountQuery) []
|
||||
, "income" $ expectEq (namesfrom journalIncomeAccountQuery) ["income","income:gifts","income:salary"]
|
||||
, "expenses" $ expectEq (namesfrom journalExpenseAccountQuery) ["expenses","expenses:food","expenses:supplies"]
|
||||
]
|
||||
]
|
||||
|
||||
@ -52,7 +52,7 @@ import System.Environment (getEnv)
|
||||
import System.Exit (exitFailure)
|
||||
import System.FilePath
|
||||
import System.IO
|
||||
import Test.HUnit
|
||||
import Test.HUnit hiding (test)
|
||||
import Text.Printf
|
||||
|
||||
import Hledger.Data.Dates (getCurrentDay, parsedate, showDate)
|
||||
@ -364,7 +364,7 @@ tests_Hledger_Read = TestList $
|
||||
|
||||
]
|
||||
|
||||
easytests = scope "Read" $ tests [
|
||||
easytests = test "Read" $ tests [
|
||||
Hledger.Read.Common.easytests
|
||||
,JournalReader.easytests
|
||||
]
|
||||
|
||||
@ -118,7 +118,7 @@ import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
import Data.Time.LocalTime
|
||||
import System.Time (getClockTime)
|
||||
import Test.HUnit
|
||||
import Test.HUnit hiding (test)
|
||||
import EasyTest hiding (char, char')
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
@ -1234,11 +1234,11 @@ 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 "unit-price" $ expectParseEq amountp "$10 @ €0.5"
|
||||
easytests = test "Common" $ tests [
|
||||
test "amountp" $ tests [
|
||||
test "basic" $ expectParseEq amountp "$47.18" (usd 47.18)
|
||||
,test "ends-with-decimal-mark" $ expectParseEq amountp "$1." (usd 1 `withPrecision` 0)
|
||||
,test "unit-price" $ expectParseEq amountp "$10 @ €0.5"
|
||||
-- not precise enough:
|
||||
-- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalpoint=Just '.'
|
||||
amount{
|
||||
@ -1252,7 +1252,7 @@ easytests = scope "Common" $ tests [
|
||||
,astyle=amountstyle{asprecision=1, asdecimalpoint=Just '.'}
|
||||
}
|
||||
}
|
||||
,scope "total-price" $ expectParseEq amountp "$10 @@ €5"
|
||||
,test "total-price" $ expectParseEq amountp "$10 @@ €5"
|
||||
amount{
|
||||
acommodity="$"
|
||||
,aquantity=10
|
||||
|
||||
@ -86,7 +86,7 @@ import Data.Time.Calendar
|
||||
import Data.Time.LocalTime
|
||||
import EasyTest hiding (char, char')
|
||||
import Safe
|
||||
import Test.HUnit
|
||||
import Test.HUnit hiding (test)
|
||||
import Text.Megaparsec hiding (parse)
|
||||
import Text.Megaparsec.Char
|
||||
import Text.Megaparsec.Custom
|
||||
@ -816,9 +816,9 @@ tests_Hledger_Read_JournalReader = TestList $ concat [
|
||||
]]
|
||||
-}
|
||||
|
||||
easytests = scope "JournalReader" $ tests [
|
||||
scope "periodictransactionp" $ tests [
|
||||
scope "more-period-text-in-comment" $ expectParseEqIO periodictransactionp
|
||||
easytests = test "JournalReader" $ tests [
|
||||
test "periodictransactionp" $ tests [
|
||||
test "more-period-text-in-comment" $ expectParseEqIO periodictransactionp
|
||||
"~ monthly from 2018/6 ;In 2019 we will change this\n"
|
||||
nullperiodictransaction {
|
||||
ptperiodexpr = "monthly from 2018/6"
|
||||
@ -831,7 +831,7 @@ easytests = scope "JournalReader" $ tests [
|
||||
,pttags = []
|
||||
,ptpostings = []
|
||||
}
|
||||
,scope "more-period-text-in-description-after-two-spaces" $ skip >> expectParseEqIO periodictransactionp
|
||||
,_test "more-period-text-in-description-after-two-spaces" $ expectParseEqIO periodictransactionp
|
||||
"~ monthly from 2018/6 In 2019 we will change this\n"
|
||||
nullperiodictransaction {
|
||||
ptperiodexpr = "monthly from 2018/6"
|
||||
@ -839,7 +839,7 @@ easytests = scope "JournalReader" $ tests [
|
||||
,ptspan = DateSpan (Just $ parsedate "2018/06/01") Nothing
|
||||
,ptcomment = "In 2019 we will change this\n"
|
||||
}
|
||||
,scope "more-period-text-in-description-after-one-space" $ skip >> expectParseEqIO periodictransactionp
|
||||
,_test "more-period-text-in-description-after-one-space" $ skip >> expectParseEqIO periodictransactionp
|
||||
"~ monthly from 2018/6 In 2019 we will change this\n"
|
||||
nullperiodictransaction {
|
||||
ptperiodexpr = "monthly from 2018/6"
|
||||
|
||||
@ -14,7 +14,7 @@ import EasyTest
|
||||
import Safe
|
||||
import System.Exit
|
||||
import System.IO
|
||||
import Test.HUnit as HUnit
|
||||
import Test.HUnit as HUnit hiding (test)
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Custom
|
||||
|
||||
@ -22,6 +22,8 @@ import Hledger.Utils.Debug (pshow)
|
||||
import Hledger.Utils.Parse (parseWithState)
|
||||
import Hledger.Utils.UTF8IOCompat (error')
|
||||
|
||||
-- * HUnit helpers
|
||||
|
||||
-- | Get a Test's label, or the empty string.
|
||||
testName :: HUnit.Test -> String
|
||||
testName (TestLabel n _) = n
|
||||
@ -72,48 +74,6 @@ assertParseEqual'' label parse expected =
|
||||
(\actual -> assertEqual (unlines [label, "expected: " ++ show expected, " but got: " ++ show actual]) expected actual)
|
||||
$ runIdentity parse
|
||||
|
||||
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)
|
||||
|
||||
-- | Given a stateful, runnable-in-Identity-monad parser, input text, and expected parse result,
|
||||
-- make an easytest Test that parses the text and compares the result,
|
||||
-- showing a nice failure message if either step fails.
|
||||
expectParseEq :: (Monoid st, Eq a, Show a) => StateT st (ParsecT CustomErr T.Text Identity) a -> T.Text -> a -> EasyTest.Test ()
|
||||
expectParseEq parser input expected = do
|
||||
let ep = runIdentity $ parseWithState mempty parser input
|
||||
either (fail.("parse error at "++).parseErrorPretty) (expectEq' expected) ep
|
||||
|
||||
-- | Given a stateful, runnable-in-IO-monad parser, input text, and expected parse result,
|
||||
-- make an easytest Test that parses the text and compares the result,
|
||||
-- showing a nice failure message if either step fails.
|
||||
expectParseEqIO :: (Monoid st, Eq a, Show a) => StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> EasyTest.Test ()
|
||||
expectParseEqIO parser input expected = do
|
||||
ep <- io $ runParserT (evalStateT parser mempty) "" input
|
||||
either (fail.("parse error at "++).parseErrorPretty) (expectEq' expected) ep
|
||||
|
||||
-- | Like easytest's expectEq, but pretty-prints the values in failure output.
|
||||
expectEq' :: (Eq a, Show a, HasCallStack) => a -> a -> EasyTest.Test ()
|
||||
expectEq' x y = if x == y then ok else crash $
|
||||
"expected:\n" <> T.pack (pshow x) <> "\nbut got:\n" <> T.pack (pshow y) <> "\n"
|
||||
|
||||
-- | Run some hunit tests, returning True if there was a problem.
|
||||
-- With arguments, runs only tests whose names contain the first argument
|
||||
-- (case sensitive).
|
||||
@ -187,3 +147,65 @@ runHunitTests args hunittests = do
|
||||
-- -- lengths of successive summary lines are monotonically nondecreasing.
|
||||
-- erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r"
|
||||
|
||||
-- * easytest helpers
|
||||
|
||||
-- | Name the given test(s). A more readable synonym for scope.
|
||||
test :: T.Text -> EasyTest.Test a -> EasyTest.Test a
|
||||
test = scope
|
||||
|
||||
-- | Skip the given test(s), with the same type signature as test.
|
||||
_test :: T.Text -> EasyTest.Test a -> EasyTest.Test a
|
||||
_test _name = (skip >>)
|
||||
|
||||
-- | Name the given test(s). Another synonym for test.
|
||||
it :: T.Text -> EasyTest.Test a -> EasyTest.Test a
|
||||
it = test
|
||||
|
||||
-- | Name the given test(s). Another synonym for _test.
|
||||
_it :: T.Text -> EasyTest.Test a -> EasyTest.Test a
|
||||
_it = _test
|
||||
|
||||
-- | 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)
|
||||
|
||||
-- | Given a stateful, runnable-in-Identity-monad parser, input text, and expected parse result,
|
||||
-- make an easytest Test that parses the text and compares the result,
|
||||
-- showing a nice failure message if either step fails.
|
||||
expectParseEq :: (Monoid st, Eq a, Show a) => StateT st (ParsecT CustomErr T.Text Identity) a -> T.Text -> a -> EasyTest.Test ()
|
||||
expectParseEq parser input expected = do
|
||||
let ep = runIdentity $ parseWithState mempty parser input
|
||||
either (fail.("parse error at "++).parseErrorPretty) (expectEq' expected) ep
|
||||
|
||||
-- | Given a stateful, runnable-in-IO-monad parser, input text, and expected parse result,
|
||||
-- make an easytest Test that parses the text and compares the result,
|
||||
-- showing a nice failure message if either step fails.
|
||||
expectParseEqIO :: (Monoid st, Eq a, Show a) => StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> EasyTest.Test ()
|
||||
expectParseEqIO parser input expected = do
|
||||
ep <- io $ runParserT (evalStateT parser mempty) "" input
|
||||
either (fail.("parse error at "++).parseErrorPretty) (expectEq' expected) ep
|
||||
|
||||
-- | Like easytest's expectEq, but pretty-prints the values in failure output.
|
||||
expectEq' :: (Eq a, Show a, HasCallStack) => a -> a -> EasyTest.Test ()
|
||||
expectEq' x y = if x == y then ok else crash $
|
||||
"expected:\n" <> T.pack (pshow x) <> "\nbut got:\n" <> T.pack (pshow y) <> "\n"
|
||||
|
||||
-- * misc
|
||||
|
||||
printParseError :: (Show a) => a -> IO ()
|
||||
printParseError e = do putStr "parse error at "; print e
|
||||
|
||||
|
||||
@ -16,7 +16,7 @@ main = do
|
||||
-- rerunOnly 2686786430487349354 "journal.standard account types.queries.assets"
|
||||
$ tests [
|
||||
|
||||
scope "journal.standard account types.queries" $
|
||||
test "journal.standard account types.queries" $
|
||||
let
|
||||
j = samplejournal
|
||||
journalAccountNamesMatching :: Query -> Journal -> [AccountName]
|
||||
@ -24,15 +24,15 @@ main = do
|
||||
namesfrom qfunc = journalAccountNamesMatching (qfunc j) j
|
||||
in
|
||||
tests
|
||||
[ scope "assets" $
|
||||
[ test "assets" $
|
||||
expectEq (namesfrom journalAssetAccountQuery) ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]
|
||||
, scope "liabilities" $
|
||||
, test "liabilities" $
|
||||
expectEq (namesfrom journalLiabilityAccountQuery) ["liabilities","liabilities:debts"]
|
||||
, scope "equity" $
|
||||
, test "equity" $
|
||||
expectEq (namesfrom journalEquityAccountQuery) []
|
||||
, scope "income" $
|
||||
, test "income" $
|
||||
expectEq (namesfrom journalIncomeAccountQuery) ["income","income:gifts","income:salary"]
|
||||
, scope "expenses" $
|
||||
, test "expenses" $
|
||||
expectEq (namesfrom journalExpenseAccountQuery) ["expenses","expenses:food","expenses:supplies"]
|
||||
]
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user