diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index 7a77578ca..d6d53db04 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -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 diff --git a/Tests.hs b/Tests.hs index 0e92952aa..e50b39176 100644 --- a/Tests.hs +++ b/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