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 |  ,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 | ||||||
|   ] |   ] | ||||||
|  | |||||||
| @ -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"] |  | ||||||
|       ] |       ] | ||||||
|   ] |   ] | ||||||
|  | |||||||
| @ -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 | ||||||
|   ] |   ] | ||||||
|  | |||||||
| @ -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  | ||||||
|  | |||||||
| @ -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" | ||||||
|  | |||||||
| @ -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 | ||||||
|  | 
 | ||||||
|  | |||||||
| @ -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"] | ||||||
|             ] |             ] | ||||||
| 
 | 
 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user