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:
Simon Michael 2018-08-17 13:38:58 +01:00
parent 626247bacd
commit b4c336c874
7 changed files with 96 additions and 79 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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