fix nafai's bug: fail on empty account name components, don't just ignore

This commit is contained in:
Simon Michael 2009-06-05 18:02:22 +00:00
parent cb8ea69dfc
commit 3be793f108
2 changed files with 24 additions and 3 deletions

View File

@ -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

View File

@ -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