From 770136ec813cf32b61748afb2ecffa1709166ab7 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 17 May 2012 14:59:38 +0000 Subject: [PATCH] query tests cleanup --- NOTES.org | 6 +- hledger-lib/Hledger/Data.hs | 1 - hledger-lib/Hledger/Data/Query.hs | 126 +++++++++++++++++------------- 3 files changed, 77 insertions(+), 56 deletions(-) diff --git a/NOTES.org b/NOTES.org index 525ab79f6..8048857c2 100644 --- a/NOTES.org +++ b/NOTES.org @@ -14,6 +14,7 @@ hledger project notes **** 7.4.1 **** 7.2.2 **** 7.0.4 +*** release 0.18 ** errors *** hledger incomestatement --depth shows nothing *** duplicate test runs @@ -619,6 +620,7 @@ This project will go forward if **** every parser has a test and is easy to test **** easy to run any single test or module's tests **** tests run bottom up by default +**** test runner can select tests precisely eg by regexp **** test runner stops at first failure by default *** documentation @@ -1865,7 +1867,7 @@ ExitFailure (-1073741819) * journal -partial +(partial) ** 2010 *** 5/4 **** balance sheet pomodoro 1 @@ -3021,3 +3023,5 @@ move *FromOpts into toOpts ** 2012 *** 2012/5/5 release prep *** 5/14 finish parsing, tests changes +*** 5/15 matcher -> query, cleanup +*** 5/16 tests, using query consistently diff --git a/hledger-lib/Hledger/Data.hs b/hledger-lib/Hledger/Data.hs index 7a6450290..fc1a4249d 100644 --- a/hledger-lib/Hledger/Data.hs +++ b/hledger-lib/Hledger/Data.hs @@ -47,7 +47,6 @@ tests_Hledger_Data = TestList ,tests_Hledger_Data_Dates ,tests_Hledger_Data_Journal ,tests_Hledger_Data_Ledger - ,tests_Hledger_Data_Query ,tests_Hledger_Data_Posting ,tests_Hledger_Data_TimeLog ,tests_Hledger_Data_Transaction diff --git a/hledger-lib/Hledger/Data/Query.hs b/hledger-lib/Hledger/Data/Query.hs index 383814072..8f221a740 100644 --- a/hledger-lib/Hledger/Data/Query.hs +++ b/hledger-lib/Hledger/Data/Query.hs @@ -162,6 +162,21 @@ parseQuery d s = (m,qopts) (m':[]) -> m' ms -> And ms +tests_parseQuery = [ + "parseQuery" ~: do + let d = parsedate "2011/1/1" + parseQuery d "acct:'expenses:autres d\233penses' desc:b" `is` (And [Acct "expenses:autres d\233penses", Desc "b"], []) + parseQuery d "inacct:a desc:\"b b\"" `is` (Desc "b b", [QueryOptInAcct "a"]) + parseQuery d "inacct:a inacct:b" `is` (Any, [QueryOptInAcct "a", QueryOptInAcct "b"]) + ] + +-- keep synced with patterns below, excluding "not" +prefixes = map (++":") [ + "inacct","inacctonly", + "desc","acct","date","edate","status","real","empty","depth" + ] +defaultprefix = "acct" + -- | Quote-and-prefix-aware version of words - don't split on spaces which -- are inside quotes, including quotes which may have one of the specified -- prefixes in front, and maybe an additional not: prefix in front of that. @@ -182,6 +197,18 @@ words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX return $ stripquotes p pattern = many (noneOf " \n\r\"") +tests_words'' = [ + "words''" ~: do + assertEqual "1" ["a","b"] (words'' [] "a b") + assertEqual "2" ["a b"] (words'' [] "'a b'") + assertEqual "3" ["not:a","b"] (words'' [] "not:a b") + assertEqual "4" ["not:a b"] (words'' [] "not:'a b'") + assertEqual "5" ["not:a b"] (words'' [] "'not:a b'") + assertEqual "6" ["not:desc:a b"] (words'' ["desc:"] "not:desc:'a b'") + let s `gives` r = assertEqual "" r (words'' prefixes s) + "\"acct:expenses:autres d\233penses\"" `gives` ["acct:expenses:autres d\233penses"] + ] + -- -- | Parse the query string as a boolean tree of match patterns. -- parseQueryTerm :: String -> Query -- parseQueryTerm s = either (const (Any)) id $ runParser query () "" $ lexmatcher s @@ -192,13 +219,6 @@ words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX -- query :: GenParser String () Query -- query = undefined --- keep synced with patterns below, excluding "not" -prefixes = map (++":") [ - "inacct","inacctonly", - "desc","acct","date","edate","status","real","empty","depth" - ] -defaultprefix = "acct" - -- | Parse a single query term as either a query or a query option. parseQueryTerm :: Day -> String -> Either Query QueryOpt parseQueryTerm _ ('i':'n':'a':'c':'c':'t':'o':'n':'l':'y':':':s) = Right $ QueryOptInAcctOnly s @@ -221,6 +241,21 @@ parseQueryTerm _ ('d':'e':'p':'t':'h':':':s) = Left $ Depth $ readDef 0 s parseQueryTerm _ "" = Left $ Any parseQueryTerm d s = parseQueryTerm d $ defaultprefix++":"++s +tests_parseQueryTerm = [ + "parseQueryTerm" ~: do + let s `gives` r = parseQueryTerm nulldate s `is` r + "a" `gives` (Left $ Acct "a") + "acct:expenses:autres d\233penses" `gives` (Left $ Acct "expenses:autres d\233penses") + "not:desc:a b" `gives` (Left $ Not $ Desc "a b") + "status:1" `gives` (Left $ Status True) + "status:0" `gives` (Left $ Status False) + "status:" `gives` (Left $ Status False) + "real:1" `gives` (Left $ Real True) + "date:2008" `gives` (Left $ Date $ DateSpan (Just $ parsedate "2008/01/01") (Just $ parsedate "2009/01/01")) + "date:from 2012/5/17" `gives` (Left $ Date $ DateSpan (Just $ parsedate "2012/05/17") Nothing) + "inacct:a" `gives` (Right $ QueryOptInAcct "a") + ] + -- | Parse the boolean value part of a "status:" query, allowing "*" as -- another way to spell True, similar to the journal file format. parseStatus :: String -> Bool @@ -257,6 +292,24 @@ matchesPosting (Real v) p = v == isReal p matchesPosting (Empty v) Posting{pamount=a} = v == isZeroMixedAmount a matchesPosting _ _ = False +tests_matchesPosting = [ + "matchesPosting" ~: do + -- matching posting status.. + assertBool "positive match on true posting status" $ + (Status True) `matchesPosting` nullposting{pstatus=True} + assertBool "negative match on true posting status" $ + not $ (Not $ Status True) `matchesPosting` nullposting{pstatus=True} + assertBool "positive match on false posting status" $ + (Status False) `matchesPosting` nullposting{pstatus=False} + assertBool "negative match on false posting status" $ + not $ (Not $ Status False) `matchesPosting` nullposting{pstatus=False} + assertBool "positive match on true posting status acquired from transaction" $ + (Status True) `matchesPosting` nullposting{pstatus=False,ptransaction=Just nulltransaction{tstatus=True}} + assertBool "real:1 on real posting" $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting} + assertBool "real:1 on virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting} + assertBool "real:1 on balanced virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting} + ] + -- | Does the match expression match this transaction ? matchesTransaction :: Query -> Transaction -> Bool matchesTransaction (Not m) t = not $ matchesTransaction m t @@ -286,54 +339,19 @@ matchesAccount (And ms) a = all (`matchesAccount` a) ms matchesAccount (Acct r) a = regexMatchesCI r a matchesAccount _ _ = False +tests_matchesAccount = [ + "matchesAccount" ~: do + assertBool "positive acct match" $ matchesAccount (Acct "b:c") "a:bb:c:d" + -- assertBool "acct should match at beginning" $ not $ matchesAccount (Acct True "a:b") "c:a:b" + ] + -- tests tests_Hledger_Data_Query :: Test -tests_Hledger_Data_Query = TestList - [ +tests_Hledger_Data_Query = TestList $ + tests_words'' + ++ tests_parseQueryTerm + ++ tests_parseQuery + ++ tests_matchesAccount + ++ tests_matchesPosting - "parseQuery" ~: do - let d = parsedate "2011/1/1" - parseQuery d "a" `is` (Acct "a", []) - parseQuery d "acct:a" `is` (Acct "a", []) - parseQuery d "acct:a desc:b" `is` (And [Acct "a", Desc "b"], []) - parseQuery d "\"acct:expenses:autres d\233penses\"" `is` (Acct "expenses:autres d\233penses", []) - parseQuery d "not:desc:'a b'" `is` (Not $ Desc "a b", []) - - parseQuery d "inacct:a desc:b" `is` (Desc "b", [QueryOptInAcct "a"]) - parseQuery d "inacct:a inacct:b" `is` (Any, [QueryOptInAcct "a", QueryOptInAcct "b"]) - - parseQuery d "status:1" `is` (Status True, []) - parseQuery d "status:0" `is` (Status False, []) - parseQuery d "status:" `is` (Status False, []) - parseQuery d "real:1" `is` (Real True, []) - - ,"matchesAccount" ~: do - assertBool "positive acct match" $ matchesAccount (Acct "b:c") "a:bb:c:d" - -- assertBool "acct should match at beginning" $ not $ matchesAccount (Acct True "a:b") "c:a:b" - - ,"matchesPosting" ~: do - -- matching posting status.. - assertBool "positive match on true posting status" $ - (Status True) `matchesPosting` nullposting{pstatus=True} - assertBool "negative match on true posting status" $ - not $ (Not $ Status True) `matchesPosting` nullposting{pstatus=True} - assertBool "positive match on false posting status" $ - (Status False) `matchesPosting` nullposting{pstatus=False} - assertBool "negative match on false posting status" $ - not $ (Not $ Status False) `matchesPosting` nullposting{pstatus=False} - assertBool "positive match on true posting status acquired from transaction" $ - (Status True) `matchesPosting` nullposting{pstatus=False,ptransaction=Just nulltransaction{tstatus=True}} - assertBool "real:1 on real posting" $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting} - assertBool "real:1 on virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting} - assertBool "real:1 on balanced virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting} - - ,"words''" ~: do - assertEqual "1" ["a","b"] (words'' [] "a b") - assertEqual "2" ["a b"] (words'' [] "'a b'") - assertEqual "3" ["not:a","b"] (words'' [] "not:a b") - assertEqual "4" ["not:a b"] (words'' [] "not:'a b'") - assertEqual "5" ["not:a b"] (words'' [] "'not:a b'") - assertEqual "6" ["not:desc:a b"] (words'' ["desc:"] "not:desc:'a b'") - - ]