query tests cleanup
This commit is contained in:
		
							parent
							
								
									08bbb832d0
								
							
						
					
					
						commit
						770136ec81
					
				| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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'") | ||||
| 
 | ||||
|  ] | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user