fix nafai's bug: fail on empty account name components, don't just ignore
This commit is contained in:
parent
cb8ea69dfc
commit
3be793f108
@ -17,6 +17,7 @@ import System.IO (stdin)
|
||||
import Ledger.Utils
|
||||
import Ledger.Types
|
||||
import Ledger.Dates
|
||||
import Ledger.AccountName (accountNameFromComponents,accountNameComponents)
|
||||
import Ledger.Amount
|
||||
import Ledger.LedgerTransaction
|
||||
import Ledger.Posting
|
||||
@ -371,11 +372,17 @@ ledgerposting = do
|
||||
transactionaccountname :: GenParser Char LedgerFileCtx AccountName
|
||||
transactionaccountname = liftM2 (++) getParentAccount ledgeraccountname
|
||||
|
||||
-- | account names may have single spaces inside them, and are terminated by two or more spaces
|
||||
-- | Account names may have single spaces inside them, and are terminated
|
||||
-- by two or more spaces. They should have one or more components of at
|
||||
-- least one character, separated by the account separator char.
|
||||
|
||||
ledgeraccountname :: GenParser Char st String
|
||||
ledgeraccountname = do
|
||||
accountname <- many1 (nonspace <|> singlespace)
|
||||
return $ striptrailingspace accountname
|
||||
a <- many1 (nonspace <|> singlespace)
|
||||
let a' = striptrailingspace a
|
||||
when (accountNameFromComponents (accountNameComponents a') /= a')
|
||||
(fail $ "accountname seems ill-formed: "++a')
|
||||
return a'
|
||||
where
|
||||
singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})
|
||||
-- couldn't avoid consuming a final space sometimes, harmless
|
||||
|
||||
14
Tests.hs
14
Tests.hs
@ -160,6 +160,14 @@ $ printf "2009-01-01 x\n a 2\n b (b) b -1\n c\n" | hledger -f - print 2>&1;
|
||||
|
||||
@
|
||||
|
||||
Nafai's bug:
|
||||
@
|
||||
$ printf "2009/1/1 x\n a: 13\n b\n" | hledger -f - bal -E 2>&1
|
||||
"-" (line 2, column 1):
|
||||
unexpected " "
|
||||
accountname seems ill-formed: a:
|
||||
@
|
||||
|
||||
-}
|
||||
-- other test tools:
|
||||
-- http://hackage.haskell.org/cgi-bin/hackage-scripts/package/test-framework
|
||||
@ -597,6 +605,12 @@ tests = [
|
||||
assertBool "ledgerTransaction should not include a comment in the description"
|
||||
$ either (const False) ((== "a") . ltdescription) t
|
||||
|
||||
,"ledgeraccountname" ~: do
|
||||
assertBool "ledgeraccountname parses a normal accountname" $ (isRight $ parsewith ledgeraccountname "a:b:c")
|
||||
assertBool "ledgeraccountname rejects an empty inner component" $ (isLeft $ parsewith ledgeraccountname "a::c")
|
||||
assertBool "ledgeraccountname rejects an empty leading component" $ (isLeft $ parsewith ledgeraccountname ":b:c")
|
||||
assertBool "ledgeraccountname rejects an empty trailing component" $ (isLeft $ parsewith ledgeraccountname "a:b:")
|
||||
|
||||
,"ledgerposting" ~: do
|
||||
parseWithCtx ledgerposting rawposting1_str `parseis` rawposting1
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user