parsing: make bad date parse error more reliable
This commit is contained in:
		
							parent
							
								
									c562412964
								
							
						
					
					
						commit
						1f24e025da
					
				| @ -372,11 +372,12 @@ ledgerdate = do | |||||||
|   datestr <- many1 $ choice' [digit, datesepchar] |   datestr <- many1 $ choice' [digit, datesepchar] | ||||||
|   let dateparts = wordsBy (`elem` datesepchars) datestr |   let dateparts = wordsBy (`elem` datesepchars) datestr | ||||||
|   currentyear <- getYear |   currentyear <- getYear | ||||||
|   let [y,m,d] = case (dateparts,currentyear) of |   [y,m,d] <- case (dateparts,currentyear) of | ||||||
|                   ([m,d],Just y)  -> [show y,m,d] |               ([m,d],Just y)  -> return [show y,m,d] | ||||||
|                   ([_,_],Nothing) -> fail $ "partial date "++datestr++" found, but the current year is unknown" |               ([_,_],Nothing) -> fail $ "partial date "++datestr++" found, but the current year is unknown" | ||||||
|                   _               -> dateparts |               ([y,m,d],_)     -> return [y,m,d] | ||||||
|       maybedate = fromGregorianValid (read y) (read m) (read d) |               _               -> fail $ "bad date: " ++ datestr | ||||||
|  |   let maybedate = fromGregorianValid (read y) (read m) (read d) | ||||||
|   case maybedate of |   case maybedate of | ||||||
|     Nothing   -> fail $ "bad date: " ++ datestr |     Nothing   -> fail $ "bad date: " ++ datestr | ||||||
|     Just date -> return date |     Just date -> return date | ||||||
| @ -715,6 +716,11 @@ tests_Hledger_Read_JournalReader = TestList [ | |||||||
|      assertParse (parseWithCtx nullctx ledgercommentline " \t; x\n") |      assertParse (parseWithCtx nullctx ledgercommentline " \t; x\n") | ||||||
|      assertParse (parseWithCtx nullctx ledgercommentline ";x") |      assertParse (parseWithCtx nullctx ledgercommentline ";x") | ||||||
| 
 | 
 | ||||||
|  |   ,"ledgerdate" ~: do | ||||||
|  |      assertParse (parseWithCtx nullctx ledgerdate "2011/1/1") | ||||||
|  |      assertParseFailure (parseWithCtx nullctx ledgerdate "1/1") | ||||||
|  |      assertParse (parseWithCtx nullctx{ctxYear=Just 2011} ledgerdate "1/1") | ||||||
|  | 
 | ||||||
|   ,"ledgerDefaultYear" ~: do |   ,"ledgerDefaultYear" ~: do | ||||||
|      assertParse (parseWithCtx nullctx ledgerDefaultYear "Y 2010\n") |      assertParse (parseWithCtx nullctx ledgerDefaultYear "Y 2010\n") | ||||||
|      assertParse (parseWithCtx nullctx ledgerDefaultYear "Y 10001\n") |      assertParse (parseWithCtx nullctx ledgerDefaultYear "Y 10001\n") | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user