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