From cbc7661703862416df72767af27eb22e28a3d41c Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 12 Nov 2012 16:31:43 +0000 Subject: [PATCH] 87: fix an arithmetic and transaction balancing bug with multiple total-priced amounts --- hledger-lib/Hledger/Data/Amount.hs | 65 +++++- hledger-lib/Hledger/Data/Transaction.hs | 15 ++ tests/87-wrong-balance.test | 53 +++++ tests/prices.test | 277 +++++++++++++++--------- 4 files changed, 299 insertions(+), 111 deletions(-) create mode 100644 tests/87-wrong-balance.test diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 35a6ead8c..7a7482944 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -51,6 +51,7 @@ module Hledger.Data.Amount ( -- ** arithmetic costOfAmount, divideAmount, + sumAmounts, -- ** rendering showAmount, showAmountDebug, @@ -62,6 +63,7 @@ module Hledger.Data.Amount ( missingmixedamt, amounts, normaliseMixedAmountPreservingFirstPrice, + normaliseMixedAmountPreservingPrices, canonicaliseMixedAmountCommodity, mixedAmountWithCommodity, setMixedAmountPrecision, @@ -77,6 +79,7 @@ module Hledger.Data.Amount ( showMixedAmountWithoutPrice, showMixedAmountWithPrecision, -- * misc. + ltraceamount, tests_Hledger_Data_Amount ) where @@ -125,6 +128,24 @@ similarAmountsOp op a@(Amount Commodity{precision=ap} _ _) (Amount bc@Commodity{ amountWithCommodity :: Commodity -> Amount -> Amount amountWithCommodity c (Amount _ q _) = Amount c q Nothing +-- | A more complete amount adding operation. +sumAmounts :: [Amount] -> MixedAmount +sumAmounts = normaliseMixedAmountPreservingPrices . Mixed + +tests_sumAmounts = [ + "sumAmounts" ~: do + -- when adding, we don't convert to the price commodity - just + -- combine what amounts we can. + -- amounts with same unit price + (sumAmounts [(Amount dollar 1 (Just $ UnitPrice $ Mixed [euros 1])), (Amount dollar 1 (Just $ UnitPrice $ Mixed [euros 1]))]) + `is` (Mixed [Amount dollar 2 (Just $ UnitPrice $ Mixed [euros 1])]) + -- amounts with different unit prices + -- amounts with total prices + (sumAmounts [(Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1])), (Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1]))]) + `is` (Mixed [(Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1])), (Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1]))]) + -- amounts with no, unit, and/or total prices + ] + -- | Convert an amount to the commodity of its assigned price, if any. Notes: -- -- - price amounts must be MixedAmounts with exactly one component Amount (or there will be a runtime error) @@ -284,9 +305,9 @@ missingamt = Amount unknown{symbol="AUTO"} 0 Nothing missingmixedamt :: MixedAmount missingmixedamt = Mixed [missingamt] --- | Simplify a mixed amount's component amounts: combine amounts with the --- same commodity and price. Also remove any zero or missing amounts and --- replace an empty amount list with a single zero amount. +-- | Simplify a mixed amount's component amounts: we can combine amounts +-- with the same commodity and unit price. Also remove any zero or missing +-- amounts and replace an empty amount list with a single zero amount. normaliseMixedAmountPreservingPrices :: MixedAmount -> MixedAmount normaliseMixedAmountPreservingPrices (Mixed as) = Mixed as'' where @@ -294,13 +315,29 @@ normaliseMixedAmountPreservingPrices (Mixed as) = Mixed as'' (_,nonzeros) = partition isReallyZeroAmount $ filter (/= missingamt) as' as' = map sumAmountsUsingFirstPrice $ group $ sort as sort = sortBy (\a1 a2 -> compare (sym a1,price a1) (sym a2,price a2)) - group = groupBy (\a1 a2 -> sym a1 == sym a2 && price a1 == price a2) sym = symbol . commodity + group = groupBy (\a1 a2 -> sym a1 == sym a2 && sameunitprice a1 a2) + where + sameunitprice a1 a2 = + case (price a1, price a2) of + (Nothing, Nothing) -> True + (Just (UnitPrice p1), Just (UnitPrice p2)) -> p1 == p2 + _ -> False tests_normaliseMixedAmountPreservingPrices = [ "normaliseMixedAmountPreservingPrices" ~: do - -- assertEqual "" (Mixed [dollars 2]) (normaliseMixedAmountPreservingPrices $ Mixed [dollars 0, dollars 2]) - assertEqual "" (Mixed [nullamt]) (normaliseMixedAmountPreservingPrices $ Mixed [dollars 0, missingamt]) + assertEqual "discard missing amount" (Mixed [nullamt]) (normaliseMixedAmountPreservingPrices $ Mixed [dollars 0, missingamt]) + assertEqual "combine unpriced same-commodity amounts" (Mixed [dollars 2]) (normaliseMixedAmountPreservingPrices $ Mixed [dollars 0, dollars 2]) + assertEqual "don't combine total-priced amounts" + (Mixed + [Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1]) + ,Amount dollar (-2) (Just $ TotalPrice $ Mixed [euros 1]) + ]) + (normaliseMixedAmountPreservingPrices $ Mixed + [Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1]) + ,Amount dollar (-2) (Just $ TotalPrice $ Mixed [euros 1]) + ]) + ] -- | Simplify a mixed amount's component amounts: combine amounts with @@ -379,6 +416,10 @@ mixedAmountWithCommodity c (Mixed as) = Amount c total Nothing showMixedAmount :: MixedAmount -> String showMixedAmount m = vConcatRightAligned $ map showAmount $ amounts $ normaliseMixedAmountPreservingFirstPrice m +-- | Compact labelled trace of a mixed amount. +ltraceamount :: String -> MixedAmount -> MixedAmount +ltraceamount s = tracewith (((s ++ ": ") ++).showMixedAmount) + -- | Set the display precision in the amount's commodities. setMixedAmountPrecision :: Int -> MixedAmount -> MixedAmount setMixedAmountPrecision p (Mixed as) = Mixed $ map (setAmountPrecision p) as @@ -416,6 +457,7 @@ canonicaliseMixedAmountCommodity canonicalcommoditymap (Mixed as) = Mixed $ map tests_Hledger_Data_Amount = TestList $ tests_normaliseMixedAmountPreservingPrices + ++ tests_sumAmounts ++ [ -- Amount @@ -436,7 +478,7 @@ tests_Hledger_Data_Amount = TestList $ let b = (dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]} negate b `is` b{quantity=(-1)} - ,"adding amounts" ~: do + ,"adding amounts without prices" ~: do let a1 = dollars 1.23 let a2 = dollars (-1.23) let a3 = dollars (-1.23) @@ -474,6 +516,15 @@ tests_Hledger_Data_Amount = TestList $ Amount dollar (-0.25) Nothing]) `is` Mixed [Amount unknown 0 Nothing] + ,"adding mixed amounts with total prices" ~: do + (sum $ map (Mixed . (\a -> [a])) + [Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1]) + ,Amount dollar (-2) (Just $ TotalPrice $ Mixed [euros 1]) + ]) + `is` (Mixed [Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1]) + ,Amount dollar (-2) (Just $ TotalPrice $ Mixed [euros 1]) + ]) + ,"showMixedAmount" ~: do showMixedAmount (Mixed [dollars 1]) `is` "$1.00" showMixedAmount (Mixed [(dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]}]) `is` "$1.00 @ €2.00" diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 2ece21a3d..eba5f8033 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -455,12 +455,14 @@ tests_Hledger_Data_Transaction = TestList $ concat [ [Posting False "a" (Mixed [dollars 1]) "" RegularPosting [] Nothing, Posting False "b" (Mixed [dollars 1]) "" RegularPosting [] Nothing ] "")) + assertBool "detect unbalanced entry, multiple missing amounts" (isLeft $ balanceTransaction Nothing (Transaction (parsedate "2007/01/28") Nothing False "" "test" "" [] [Posting False "a" missingmixedamt "" RegularPosting [] Nothing, Posting False "b" missingmixedamt "" RegularPosting [] Nothing ] "")) + let e = balanceTransaction Nothing (Transaction (parsedate "2007/01/28") Nothing False "" "" "" [] [Posting False "a" (Mixed [dollars 1]) "" RegularPosting [] Nothing, Posting False "b" missingmixedamt "" RegularPosting [] Nothing @@ -471,6 +473,7 @@ tests_Hledger_Data_Transaction = TestList $ concat [ (case e of Right e' -> (pamount $ last $ tpostings e') Left _ -> error' "should not happen") + let e = balanceTransaction Nothing (Transaction (parsedate "2011/01/01") Nothing False "" "" "" [] [Posting False "a" (Mixed [dollars 1.35]) "" RegularPosting [] Nothing, Posting False "b" (Mixed [euros (-1)]) "" RegularPosting [] Nothing @@ -486,6 +489,18 @@ tests_Hledger_Data_Transaction = TestList $ concat [ Right e' -> (pamount $ head $ tpostings e') Left _ -> error' "should not happen") + assertBool "balanceTransaction balances based on cost if there are unit prices" (isRight $ + balanceTransaction Nothing (Transaction (parsedate "2011/01/01") Nothing False "" "" "" [] + [Posting False "a" (Mixed [Amount dollar 1 (Just $ UnitPrice $ Mixed [euros 2])]) "" RegularPosting [] Nothing + ,Posting False "a" (Mixed [Amount dollar (-2) (Just $ UnitPrice $ Mixed [euros 1])]) "" RegularPosting [] Nothing + ] "")) + + assertBool "balanceTransaction balances based on cost if there are total prices" (isRight $ + balanceTransaction Nothing (Transaction (parsedate "2011/01/01") Nothing False "" "" "" [] + [Posting False "a" (Mixed [Amount dollar 1 (Just $ TotalPrice $ Mixed [euros 1])]) "" RegularPosting [] Nothing + ,Posting False "a" (Mixed [Amount dollar (-2) (Just $ TotalPrice $ Mixed [euros 1])]) "" RegularPosting [] Nothing + ] "")) + ,"isTransactionBalanced" ~: do let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" [] [Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t) diff --git a/tests/87-wrong-balance.test b/tests/87-wrong-balance.test new file mode 100644 index 000000000..8b8977cc3 --- /dev/null +++ b/tests/87-wrong-balance.test @@ -0,0 +1,53 @@ +# 1. issue 87, hledger should give this balance. +hledgerdev -f - balance --no-total b +<<< +1/1 + a -553.653 X @@ 2609.92 + a -5.684 X @@ 26.10 + a -50.833 X @@ 234.90 + a -49.714 X @@ 234.90 + a -49.957 X @@ 234.90 + a -49.778 X @@ 234.90 + a -142.316 X @@ 674.01 + a -49.029 X @@ 234.90 + a -51.233 X @@ 234.90 + a -49.204 X @@ 234.90 + a -49.474 X @@ 234.90 + a -47.773 X @@ 234.90 + a -109.439 X @@ 576.96 + a -31.133 X @@ 171.51 + a -438.249 X @@ 2537.90 + a -11.927 X @@ 72.03 + a -170.721 X @@ 990.18 + a 1910.117 X @@ 10742.52 + b +>>> + -969.81 b +>>>= 0 + +# 2. As above, but the prices have a commodity - should work the same. +hledgerdev -f - balance --no-total b +<<< +1/1 + a -553.653 X @@ 2609.92 Y + a -5.684 X @@ 26.10 Y + a -50.833 X @@ 234.90 Y + a -49.714 X @@ 234.90 Y + a -49.957 X @@ 234.90 Y + a -49.778 X @@ 234.90 Y + a -142.316 X @@ 674.01 Y + a -49.029 X @@ 234.90 Y + a -51.233 X @@ 234.90 Y + a -49.204 X @@ 234.90 Y + a -49.474 X @@ 234.90 Y + a -47.773 X @@ 234.90 Y + a -109.439 X @@ 576.96 Y + a -31.133 X @@ 171.51 Y + a -438.249 X @@ 2537.90 Y + a -11.927 X @@ 72.03 Y + a -170.721 X @@ 990.18 Y + a 1910.117 X @@ 10742.52 Y + b +>>> + -969.81 Y b +>>>= 0 diff --git a/tests/prices.test b/tests/prices.test index 6ca7e0152..1e59b7ed1 100644 --- a/tests/prices.test +++ b/tests/prices.test @@ -76,7 +76,179 @@ hledgerdev -f - print >>>=0 -# # 6. when the *cost-basis* balance has exactly two commodities, both +## 6. another, from ledger tests. Just one posting to price so uses @@. +hledgerdev -f - print +<<< +2002/09/30 * 1a1a6305d06ce4b284dba0d267c23f69d70c20be + c56a21d23a6535184e7152ee138c28974f14280c 866.231000 GGGGG + a35e82730cf91569c302b313780e5895f75a62b9 $-17,783.72 +>>> +2002/09/30 * 1a1a6305d06ce4b284dba0d267c23f69d70c20be + c56a21d23a6535184e7152ee138c28974f14280c 866.231000 GGGGG @@ $17,783.72 + a35e82730cf91569c302b313780e5895f75a62b9 $-17,783.72 + +>>>=0 + +# 7. when the balance has more than two commodities, don't bother +hledgerdev -f - print +<<< +2011/01/01 + expenses:foreign currency €100 + assets $-135 + expenses:other £200 +>>>= !0 + +# 8. another +hledgerdev -f - balance -B +<<< +2011/01/01 + expenses:foreign currency €99 + assets $-130 + expenses:foreign currency €1 + assets $-5 +>>> + $-135 assets + $135 expenses:foreign currency +-------------------- + 0 +>>>=0 + +# 9. transaction in two commodities should balance out properly +hledgerdev -f - balance --cost +<<< +2011/01/01 x + a 10£ @@ 16$ + b +>>> + 16$ a + -16$ b +-------------------- + 0 +>>>=0 + +# 10. When commodity price is specified implicitly, transaction should +# be considered balanced out even when first amount is negative +# (that is, price for it should be determined properly, with proper sign) +hledgerdev -f - balance +<<< +2011/01/01 x + a -10£ + b 16$ +>>> + -10£ a + 16$ b +-------------------- + 16$ + -10£ +>>>=0 + +# 11. When commodity price is specified implicitly, transaction should +# NOT be considered balanced out when BOTH amounts are negative +hledgerdev -f - balance +<<< +2011/01/01 x + a -10£ + b -16$ +>>> +>>>=1 + +# 12. Differently-priced lots of a commodity should be merged in balance report +hledgerdev -f - balance +<<< +2011/1/1 + (a) £1 @ $2 + +2011/1/1 + (a) £1 @ $3 +>>> + £2 a +-------------------- + £2 +>>>=0 + +# 13. this should balance +hledgerdev -f - balance +<<< +2011/1/1 + a 1h @ $10 + b 1h @ $20 + c $-30 +>>>= 0 + +# 14. this should balance, ignoring the P +hledgerdev -f - balance +<<< +P 2011/11/15 EUR CHF 1.234 +2011/11/19 + a EUR 1000.00 + b CHF -1254 +>>>= 0 + +# 15. these balance because of the unit prices, and should parse successfully +hledgerdev -f - balance --no-total +<<< +1/1 + a 1X @ 2Y + a -2X @ 1Y +>>> + -1X a +>>>= 0 + +# 16. +hledgerdev -f - balance --no-total -B +<<< +1/1 + a 1X @ 2Y + a -2X @ 1Y +>>> +>>>= 0 + +# 17. likewise with total prices. Note how the primary amount's sign is used. +hledgerdev -f - balance --no-total +<<< +1/1 + a 1X @@ 1Y + a -2X @@ 1Y +>>> + -1X a +>>>= 0 + +# 18. +hledgerdev -f - balance --no-total -B +<<< +1/1 + a 1X @@ 1Y + a -2X @@ 1Y +>>> +>>>= 0 + +# 19. here, a's primary amount is 0, and its cost is 1Y; b is the assigned auto-balancing amount of -1Y (per issue 69) +hledgerdev -f - balance --no-total -E +<<< +1/1 + a 1X @@ 1Y + a 1X @@ 1Y + a -2X @@ 1Y + b +>>> + 0 a + -1Y b +>>>= 0 + +# 20. the above with -B +hledgerdev -f - balance --no-total -E -B +<<< +1/1 + a 1X @@ 1Y + a 1X @@ 1Y + a -2X @@ 1Y + b +>>> + 1Y a + -1Y b +>>>= 0 + +# # when the *cost-basis* balance has exactly two commodities, both # # unpriced, infer an implicit conversion price for the first one in terms # # of the second. # hledgerdev -f - print @@ -97,106 +269,3 @@ hledgerdev -f - print # misc £1 @@ 2 shekels # misc £-1 @@ 2 shekels # -## 7. another, from ledger tests. Just one posting to price so uses @@. -hledgerdev -f - print -<<< -2002/09/30 * 1a1a6305d06ce4b284dba0d267c23f69d70c20be - c56a21d23a6535184e7152ee138c28974f14280c 866.231000 GGGGG - a35e82730cf91569c302b313780e5895f75a62b9 $-17,783.72 ->>> -2002/09/30 * 1a1a6305d06ce4b284dba0d267c23f69d70c20be - c56a21d23a6535184e7152ee138c28974f14280c 866.231000 GGGGG @@ $17,783.72 - a35e82730cf91569c302b313780e5895f75a62b9 $-17,783.72 - ->>>=0 - -# 8. when the balance has more than two commodities, don't bother -hledgerdev -f - print -<<< -2011/01/01 - expenses:foreign currency €100 - assets $-135 - expenses:other £200 ->>>= !0 -# 9. another -hledgerdev -f - balance -B -<<< -2011/01/01 - expenses:foreign currency €99 - assets $-130 - expenses:foreign currency €1 - assets $-5 ->>> - $-135 assets - $135 expenses:foreign currency --------------------- - 0 ->>>=0 -# 10. transaction in two commodities should balance out properly -hledgerdev -f - balance --cost -<<< -2011/01/01 x - a 10£ @@ 16$ - b ->>> - 16$ a - -16$ b --------------------- - 0 ->>>=0 -# 11. When commodity price is specified implicitly, transaction should -# be considered balanced out even when first amount is negative -# (that is, price for it should be determined properly, with proper sign) -hledgerdev -f - balance -<<< -2011/01/01 x - a -10£ - b 16$ ->>> - -10£ a - 16$ b --------------------- - 16$ - -10£ ->>>=0 -# 12. When commodity price is specified implicitly, transaction should -# NOT be considered balanced out when BOTH amounts are negative -hledgerdev -f - balance -<<< -2011/01/01 x - a -10£ - b -16$ ->>> ->>>=1 - -# 13. Differently-priced lots of a commodity should be merged in balance report -hledgerdev -f - balance -<<< -2011/1/1 - (a) £1 @ $2 - -2011/1/1 - (a) £1 @ $3 ->>> - £2 a --------------------- - £2 ->>>=0 - -# 14. this should balance -hledgerdev -f - balance -<<< -2011/1/1 - a 1h @ $10 - b 1h @ $20 - c $-30 ->>>= 0 - -# 15. this should balance, ignoring the P -hledgerdev -f - balance -<<< -P 2011/11/15 EUR CHF 1.234 -2011/11/19 - a EUR 1000.00 - b CHF -1254 ->>>= 0