From 04450862868ccfcc3cb81950a850524822ca5e60 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 3 Jul 2007 18:20:45 +0000 Subject: [PATCH] tests cleanup --- NOTES | 41 ++-------------- Tests.hs | 139 +++++++++++++++++++++++++++++++---------------------- hledger.hs | 13 +++-- 3 files changed, 93 insertions(+), 100 deletions(-) diff --git a/NOTES b/NOTES index b654be4f7..f26898985 100644 --- a/NOTES +++ b/NOTES @@ -2,10 +2,14 @@ hledger project notes * TO DO ** bugs +** compatibility +*** , in thousands +*** use greatest precision in register +*** abbreviate 0 +*** don't combine entries so much in register ** basic features *** print *** !include -*** , in thousands *** -j and -J graph data output ** advanced features @@ -67,38 +71,3 @@ what does my balance future look like ? are there any cashflow, tax, budgetary problems looming ? * misc -** testing support - --- {- | looks in Tests.hs for functions like prop_foo and returns --- the list. Requires that Tests.hs be valid Haskell98. -} --- tests :: [String] --- tests = unsafePerformIO $ --- do h <- openFile "src/Tests.hs" ReadMode --- s <- hGetContents h --- case parseModule s of --- (ParseOk (HsModule _ _ _ _ ds)) -> return (map declName (filter isProp ds)) --- (ParseFailed loc s’) -> error (s’ ++ ” ” ++ show loc) - --- {- | checks if function binding name starts with @prop_@ indicating --- that it is a quickcheck property -} --- isProp :: HsDecl -> Bool --- isProp d@(HsFunBind _) = “prop_” `isPrefixOf` (declName d) --- isProp _ = False - --- {- | takes an HsDecl and returns the name of the declaration -} --- declName :: HsDecl -> String --- declName (HsFunBind (HsMatch _ (HsIdent name) _ _ _:_)) = name --- declName _ = undefined - --- mkCheck name = [| putStr (name ++ ": ") --- >> quickCheck $(varE (mkName name)) |] - --- mkChecks [] = undefined -- if we don't have any tests, then the test suite is undefined right? --- mkChecks [name] = mkCheck name --- mkChecks (name:ns) = [| $(mkCheck name) >> $(mkChecks ns) |] - --- {-# OPTIONS_GHC -fno-warn-unused-imports -no-recomp -fth #-} --- runTests :: IO () --- runTests = $(mkChecks tests) - --- ghc --make Unit.hs -main-is Unit.runTests -o unit diff --git a/Tests.hs b/Tests.hs index 80181345a..5ce9f0a5a 100644 --- a/Tests.hs +++ b/Tests.hs @@ -1,4 +1,3 @@ - module Tests where import qualified Data.Map as Map @@ -9,7 +8,60 @@ import Models import Parse import Utils --- sample data +-- utils + +assertEqual' e a = assertEqual "" e a + +parse' p ts = parse p "" ts + +assertParseEqual :: (Show a, Eq a) => a -> (Either ParseError a) -> Assertion +assertParseEqual expected parsed = + case parsed of + Left e -> parseError e + Right v -> assertEqual " " expected v + +parseEqual :: Eq a => (Either ParseError a) -> a -> Bool +parseEqual parsed other = + case parsed of + Left e -> False + Right v -> v == other + +-- find tests with template haskell +-- +-- {-# OPTIONS_GHC -fno-warn-unused-imports -no-recomp -fth #-} +-- {- ghc --make Unit.hs -main-is Unit.runTests -o unit -} +-- runTests :: IO () +-- runTests = $(mkChecks props) + +-- mkChecks [] = undefined +-- mkChecks [name] = mkCheck name +-- mkChecks (name:ns) = [| $(mkCheck name) >> $(mkChecks ns) |] + +-- mkCheck name = [| putStr (name ++ ": ") >> quickCheck $(varE (mkName name)) |] + +-- {- | looks in Tests.hs for functions like prop_foo and returns +-- the list. Requires that Tests.hs be valid Haskell98. -} +-- props :: [String] +-- props = unsafePerformIO $ +-- do h <- openFile "Tests.hs" ReadMode +-- s <- hGetContents h +-- case parseModule s of +-- (ParseOk (HsModule _ _ _ _ ds)) -> return (map declName (filter isProp ds)) +-- (ParseFailed loc s') -> error (s' ++ " " ++ show loc) + +-- {- | checks if function binding name starts with @prop_@ indicating +-- that it is a quickcheck property -} +-- isProp :: HsDecl -> Bool +-- isProp d@(HsFunBind _) = "prop_" `isPrefixOf` (declName d) +-- isProp _ = False + +-- {- | takes an HsDecl and returns the name of the declaration -} +-- declName :: HsDecl -> String +-- declName (HsFunBind (HsMatch _ (HsIdent name) _ _ _:_)) = name +-- declName _ = undefined + + +-- test data transaction1_str = " expenses:food:dining $10.00\n" @@ -236,37 +288,29 @@ timelog1 = TimeLog [ timelogentry2 ] +-- tests --- utils +quickcheck = mapM quickCheck ([ + ] :: [Bool]) -assertEqual' e a = assertEqual "" e a - -parse' p ts = parse p "" ts - -assertParseEqual :: (Show a, Eq a) => a -> (Either ParseError a) -> Assertion -assertParseEqual expected parsed = - case parsed of - Left e -> parseError e - Right v -> assertEqual " " expected v - -parseEquals :: Eq a => (Either ParseError a) -> a -> Bool -parseEquals parsed other = - case parsed of - Left e -> False - Right v -> v == other - --- hunit tests - -tests = runTestTT $ test [ - 2 @=? 2 - , test_ledgertransaction - , test_ledgerentry - , test_autofillEntry - , test_expandAccountNames - , test_ledgerAccountNames - , test_cacheLedger - , test_showLedgerAccounts - ] +hunit = runTestTT $ "hunit" ~: test ([ + "" ~: parseLedgerPatternArgs [] @=? ([],[]) + ,"" ~: parseLedgerPatternArgs ["a"] @=? (["a"],[]) + ,"" ~: parseLedgerPatternArgs ["a","b"] @=? (["a","b"],[]) + ,"" ~: parseLedgerPatternArgs ["a","b","--"] @=? (["a","b"],[]) + ,"" ~: parseLedgerPatternArgs ["a","b","--","c","b"] @=? (["a","b"],["c","b"]) + ,"" ~: parseLedgerPatternArgs ["--","c"] @=? ([],["c"]) + ,"" ~: parseLedgerPatternArgs ["--"] @=? ([],[]) + ,"" ~: test_ledgertransaction + ,"" ~: test_ledgerentry + ,"" ~: test_autofillEntry + ,"" ~: test_timelogentry + ,"" ~: test_timelog + ,"" ~: test_expandAccountNames + ,"" ~: test_ledgerAccountNames + ,"" ~: test_cacheLedger + ,"" ~: test_showLedgerAccounts + ] :: [Test]) test_ledgertransaction :: Assertion test_ledgertransaction = @@ -280,6 +324,13 @@ test_autofillEntry = (Amount (getcurrency "$") (-47.18)) (tamount $ last $ etransactions $ autofillEntry entry1) +test_timelogentry = do + assertParseEqual timelogentry1 (parse' timelogentry timelogentry1_str) + assertParseEqual timelogentry2 (parse' timelogentry timelogentry2_str) + +test_timelog = + assertParseEqual timelog1 (parse' timelog timelog1_str) + test_expandAccountNames = assertEqual' ["assets","assets:cash","assets:checking","expenses","expenses:vacation"] @@ -298,29 +349,3 @@ test_cacheLedger = test_showLedgerAccounts = assertEqual' 4 (length $ lines $ showLedgerAccounts l7 [] False 1) --- quickcheck properties - -props = mapM quickCheck - [ - parse' ledgertransaction transaction1_str `parseEquals` - (Transaction "expenses:food:dining" (Amount (getcurrency "$") 10)) - , - rawLedgerAccountNames ledger7 == - ["assets","assets:cash","assets:checking","assets:saving","equity", - "equity:opening balances","expenses","expenses:food","expenses:food:dining", - "expenses:phone","expenses:vacation","liabilities","liabilities:credit cards", - "liabilities:credit cards:discover"] - , - parseLedgerPatternArgs [] == ([],[]) - ,parseLedgerPatternArgs ["a"] == (["a"],[]) - ,parseLedgerPatternArgs ["a","b"] == (["a","b"],[]) - ,parseLedgerPatternArgs ["a","b","--"] == (["a","b"],[]) - ,parseLedgerPatternArgs ["a","b","--","c","b"] == (["a","b"],["c","b"]) - ,parseLedgerPatternArgs ["--","c"] == ([],["c"]) - ,parseLedgerPatternArgs ["--"] == ([],[]) - ,parse' timelogentry timelogentry1_str `parseEquals` timelogentry1 - ,parse' timelogentry timelogentry2_str `parseEquals` timelogentry2 - ,parse' timelog timelog1_str `parseEquals` timelog1 - ] - - diff --git a/hledger.hs b/hledger.hs index c2b3ac20c..609edd5c2 100644 --- a/hledger.hs +++ b/hledger.hs @@ -33,6 +33,12 @@ main = do -- commands +selftest :: IO () -- "hledger test" +selftest = do + Tests.hunit + Tests.quickcheck + return () + register :: [Flag] -> [String] -> [String] -> IO () register opts acctpats descpats = do doWithLedger opts printRegister @@ -54,13 +60,6 @@ balance opts acctpats _ = do ([],False) -> 1 otherwise -> 9999 -selftest :: IO () -selftest = do - Tests.tests - Tests.props - -- Amount.tests - return () - -- utils doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO ()