diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index 87a71be7c..ebccfe0bb 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -18,6 +18,8 @@ quarterly, etc. -} +-- XXX fromGregorian silently clips bad dates, use fromGregorianValid instead ? + module Hledger.Data.Dates where diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 9820f8eb3..7fc077d98 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -347,20 +347,15 @@ ledgerdate = do -- pos <- getPosition datestr <- many1 $ choice' [digit, datesepchar] let dateparts = wordsBy (`elem` datesepchars) datestr - case dateparts of - [y,m,d] -> do - failIfInvalidYear y - failIfInvalidMonth m - failIfInvalidDay d - return $ fromGregorian (read y) (read m) (read d) - [m,d] -> do - y <- getYear - case y of Nothing -> fail "partial date found, but no default year specified" - Just y' -> do failIfInvalidYear $ show y' - failIfInvalidMonth m - failIfInvalidDay d - return $ fromGregorian y' (read m) (read d) - _ -> fail $ "bad date: " ++ datestr + currentyear <- getYear + let [y,m,d] = case (dateparts,currentyear) of + ([m,d],Just y) -> [show y,m,d] + ([_,_],Nothing) -> fail $ "partial date "++datestr++" found, but the current year is unknown" + _ -> dateparts + maybedate = fromGregorianValid (read y) (read m) (read d) + case maybedate of + Nothing -> fail $ "bad date: " ++ datestr + Just date -> return date "full or partial date" ledgerdatetime :: GenParser Char JournalContext LocalTime diff --git a/tests/parse-dates.test b/tests/parse-dates.test index 8363dbeee..49eba46de 100644 --- a/tests/parse-dates.test +++ b/tests/parse-dates.test @@ -5,7 +5,7 @@ bin/hledger -f- print 2010/31/12 x a 1 b ->>>2 /bad month number: 31/ +>>>2 /bad date/ >>>= 1 # 2. too-large day bin/hledger -f- print @@ -13,7 +13,7 @@ bin/hledger -f- print 2010/12/32 x a 1 b ->>>2 /bad day number: 32/ +>>>2 /bad date/ >>>= 1 # 3. 29th feb on leap year should be ok bin/hledger -f- print @@ -27,11 +27,11 @@ bin/hledger -f- print b -1 >>>= 0 -# 3. 29th feb on non-leap year should fail +# 4. 29th feb on non-leap year should fail bin/hledger -f- print <<< 2001/2/29 x a 1 b ->>>2 /bad day number: 29/ +>>>2 /bad date/ >>>= 1