diff --git a/hledger-lib/Hledger.hs b/hledger-lib/Hledger.hs index 832f3d081..40cff951c 100644 --- a/hledger-lib/Hledger.hs +++ b/hledger-lib/Hledger.hs @@ -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 ] diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 98f3f144d..a3fb674ea 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -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"] ] ] diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index e59560392..cef5adc39 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -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 ] diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 61be79282..e06d06a8e 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -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 diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index c4f138965..99ba86cf2 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -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" diff --git a/hledger-lib/Hledger/Utils/Test.hs b/hledger-lib/Hledger/Utils/Test.hs index c63d49ef5..2ee4ecfd8 100644 --- a/hledger-lib/Hledger/Utils/Test.hs +++ b/hledger-lib/Hledger/Utils/Test.hs @@ -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 + diff --git a/hledger-lib/tests/easytests.hs b/hledger-lib/tests/easytests.hs index 65acc87e9..47f9f3193 100755 --- a/hledger-lib/tests/easytests.hs +++ b/hledger-lib/tests/easytests.hs @@ -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"] ]