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 ,Hledger.easytests
) )
where where
import Test.HUnit import Test.HUnit hiding (test)
import EasyTest import EasyTest
import Hledger.Data as X hiding (easytests) import Hledger.Data as X hiding (easytests)
@ -26,7 +26,7 @@ tests_Hledger = TestList
,tests_Hledger_Utils ,tests_Hledger_Utils
] ]
easytests = scope "Hledger" $ tests [ easytests = test "Hledger" $ tests [
Hledger.Data.easytests Hledger.Data.easytests
,Hledger.Read.easytests ,Hledger.Read.easytests
] ]

View File

@ -97,7 +97,7 @@ import Safe (headMay, headDef)
import Data.Time.Calendar import Data.Time.Calendar
import Data.Tree import Data.Tree
import System.Time (ClockTime(TOD)) import System.Time (ClockTime(TOD))
import Test.HUnit import Test.HUnit hiding (test)
import Text.Printf import Text.Printf
import qualified Data.Map as M import qualified Data.Map as M
@ -1088,23 +1088,18 @@ tests_Hledger_Data_Journal = TestList $
-- journalProfitAndLossAccountNames j `is` ["expenses","expenses:e","income","income:i"] -- journalProfitAndLossAccountNames j `is` ["expenses","expenses:e","income","income:i"]
] ]
easytests = scope "Journal" $ tests [ easytests = test "Journal" $ tests [
scope "standard account types" $ do test "standard account types" $ do
let let
j = samplejournal j = samplejournal
journalAccountNamesMatching :: Query -> Journal -> [AccountName] journalAccountNamesMatching :: Query -> Journal -> [AccountName]
journalAccountNamesMatching q = filter (q `matchesAccount`) . journalAccountNames journalAccountNamesMatching q = filter (q `matchesAccount`) . journalAccountNames
namesfrom qfunc = journalAccountNamesMatching (qfunc j) j namesfrom qfunc = journalAccountNamesMatching (qfunc j) j
tests tests
[ scope "assets" $ [ "assets" $ expectEq (namesfrom journalAssetAccountQuery) ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]
expectEq (namesfrom journalAssetAccountQuery) ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"] , "liabilities" $ expectEq (namesfrom journalLiabilityAccountQuery) ["liabilities","liabilities:debts"]
, scope "liabilities" $ , "equity" $ expectEq (namesfrom journalEquityAccountQuery) []
expectEq (namesfrom journalLiabilityAccountQuery) ["liabilities","liabilities:debts"] , "income" $ expectEq (namesfrom journalIncomeAccountQuery) ["income","income:gifts","income:salary"]
, scope "equity" $ , "expenses" $ expectEq (namesfrom journalExpenseAccountQuery) ["expenses","expenses:food","expenses:supplies"]
expectEq (namesfrom journalEquityAccountQuery) []
, scope "income" $
expectEq (namesfrom journalIncomeAccountQuery) ["income","income:gifts","income:salary"]
, scope "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.Exit (exitFailure)
import System.FilePath import System.FilePath
import System.IO import System.IO
import Test.HUnit import Test.HUnit hiding (test)
import Text.Printf import Text.Printf
import Hledger.Data.Dates (getCurrentDay, parsedate, showDate) 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 Hledger.Read.Common.easytests
,JournalReader.easytests ,JournalReader.easytests
] ]

View File

@ -118,7 +118,7 @@ import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
import Data.Time.LocalTime import Data.Time.LocalTime
import System.Time (getClockTime) import System.Time (getClockTime)
import Test.HUnit import Test.HUnit hiding (test)
import EasyTest hiding (char, char') import EasyTest hiding (char, char')
import Text.Megaparsec import Text.Megaparsec
import Text.Megaparsec.Char import Text.Megaparsec.Char
@ -1234,11 +1234,11 @@ tests_Hledger_Read_Common = TestList [
test_spaceandamountormissingp test_spaceandamountormissingp
] ]
easytests = scope "Common" $ tests [ easytests = test "Common" $ tests [
scope "amountp" $ tests [ test "amountp" $ tests [
scope "basic" $ expectParseEq amountp "$47.18" (usd 47.18) test "basic" $ expectParseEq amountp "$47.18" (usd 47.18)
,scope "ends-with-decimal-mark" $ expectParseEq amountp "$1." (usd 1 `withPrecision` 0) ,test "ends-with-decimal-mark" $ expectParseEq amountp "$1." (usd 1 `withPrecision` 0)
,scope "unit-price" $ expectParseEq amountp "$10 @ €0.5" ,test "unit-price" $ expectParseEq amountp "$10 @ €0.5"
-- not precise enough: -- not precise enough:
-- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalpoint=Just '.' -- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalpoint=Just '.'
amount{ amount{
@ -1252,7 +1252,7 @@ easytests = scope "Common" $ tests [
,astyle=amountstyle{asprecision=1, asdecimalpoint=Just '.'} ,astyle=amountstyle{asprecision=1, asdecimalpoint=Just '.'}
} }
} }
,scope "total-price" $ expectParseEq amountp "$10 @@ €5" ,test "total-price" $ expectParseEq amountp "$10 @@ €5"
amount{ amount{
acommodity="$" acommodity="$"
,aquantity=10 ,aquantity=10

View File

@ -86,7 +86,7 @@ import Data.Time.Calendar
import Data.Time.LocalTime import Data.Time.LocalTime
import EasyTest hiding (char, char') import EasyTest hiding (char, char')
import Safe import Safe
import Test.HUnit import Test.HUnit hiding (test)
import Text.Megaparsec hiding (parse) import Text.Megaparsec hiding (parse)
import Text.Megaparsec.Char import Text.Megaparsec.Char
import Text.Megaparsec.Custom import Text.Megaparsec.Custom
@ -816,9 +816,9 @@ tests_Hledger_Read_JournalReader = TestList $ concat [
]] ]]
-} -}
easytests = scope "JournalReader" $ tests [ easytests = test "JournalReader" $ tests [
scope "periodictransactionp" $ tests [ test "periodictransactionp" $ tests [
scope "more-period-text-in-comment" $ expectParseEqIO periodictransactionp test "more-period-text-in-comment" $ expectParseEqIO periodictransactionp
"~ monthly from 2018/6 ;In 2019 we will change this\n" "~ monthly from 2018/6 ;In 2019 we will change this\n"
nullperiodictransaction { nullperiodictransaction {
ptperiodexpr = "monthly from 2018/6" ptperiodexpr = "monthly from 2018/6"
@ -831,7 +831,7 @@ easytests = scope "JournalReader" $ tests [
,pttags = [] ,pttags = []
,ptpostings = [] ,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" "~ monthly from 2018/6 In 2019 we will change this\n"
nullperiodictransaction { nullperiodictransaction {
ptperiodexpr = "monthly from 2018/6" ptperiodexpr = "monthly from 2018/6"
@ -839,7 +839,7 @@ easytests = scope "JournalReader" $ tests [
,ptspan = DateSpan (Just $ parsedate "2018/06/01") Nothing ,ptspan = DateSpan (Just $ parsedate "2018/06/01") Nothing
,ptcomment = "In 2019 we will change this\n" ,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" "~ monthly from 2018/6 In 2019 we will change this\n"
nullperiodictransaction { nullperiodictransaction {
ptperiodexpr = "monthly from 2018/6" ptperiodexpr = "monthly from 2018/6"

View File

@ -14,7 +14,7 @@ import EasyTest
import Safe import Safe
import System.Exit import System.Exit
import System.IO import System.IO
import Test.HUnit as HUnit import Test.HUnit as HUnit hiding (test)
import Text.Megaparsec import Text.Megaparsec
import Text.Megaparsec.Custom import Text.Megaparsec.Custom
@ -22,6 +22,8 @@ import Hledger.Utils.Debug (pshow)
import Hledger.Utils.Parse (parseWithState) import Hledger.Utils.Parse (parseWithState)
import Hledger.Utils.UTF8IOCompat (error') import Hledger.Utils.UTF8IOCompat (error')
-- * HUnit helpers
-- | Get a Test's label, or the empty string. -- | Get a Test's label, or the empty string.
testName :: HUnit.Test -> String testName :: HUnit.Test -> String
testName (TestLabel n _) = n 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) (\actual -> assertEqual (unlines [label, "expected: " ++ show expected, " but got: " ++ show actual]) expected actual)
$ runIdentity parse $ 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. -- | Run some hunit tests, returning True if there was a problem.
-- With arguments, runs only tests whose names contain the first argument -- With arguments, runs only tests whose names contain the first argument
-- (case sensitive). -- (case sensitive).
@ -187,3 +147,65 @@ runHunitTests args hunittests = do
-- -- lengths of successive summary lines are monotonically nondecreasing. -- -- lengths of successive summary lines are monotonically nondecreasing.
-- erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r" -- 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" -- rerunOnly 2686786430487349354 "journal.standard account types.queries.assets"
$ tests [ $ tests [
scope "journal.standard account types.queries" $ test "journal.standard account types.queries" $
let let
j = samplejournal j = samplejournal
journalAccountNamesMatching :: Query -> Journal -> [AccountName] journalAccountNamesMatching :: Query -> Journal -> [AccountName]
@ -24,15 +24,15 @@ main = do
namesfrom qfunc = journalAccountNamesMatching (qfunc j) j namesfrom qfunc = journalAccountNamesMatching (qfunc j) j
in in
tests tests
[ scope "assets" $ [ test "assets" $
expectEq (namesfrom journalAssetAccountQuery) ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"] expectEq (namesfrom journalAssetAccountQuery) ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]
, scope "liabilities" $ , test "liabilities" $
expectEq (namesfrom journalLiabilityAccountQuery) ["liabilities","liabilities:debts"] expectEq (namesfrom journalLiabilityAccountQuery) ["liabilities","liabilities:debts"]
, scope "equity" $ , test "equity" $
expectEq (namesfrom journalEquityAccountQuery) [] expectEq (namesfrom journalEquityAccountQuery) []
, scope "income" $ , test "income" $
expectEq (namesfrom journalIncomeAccountQuery) ["income","income:gifts","income:salary"] expectEq (namesfrom journalIncomeAccountQuery) ["income","income:gifts","income:salary"]
, scope "expenses" $ , test "expenses" $
expectEq (namesfrom journalExpenseAccountQuery) ["expenses","expenses:food","expenses:supplies"] expectEq (namesfrom journalExpenseAccountQuery) ["expenses","expenses:food","expenses:supplies"]
] ]