Commit 0f0cdb68 authored by Ben Gamari's avatar Ben Gamari 🐢
Browse files

Bugfix for bug 11632: `readLitChar` should consume null characters

Test Plan: The tests have been included. This change deals with a
relatively minor edge case and should not break unrelated functionality.

Reviewers: thomie, #core_libraries_committee, ekmett, bgamari

Reviewed By: #core_libraries_committee, ekmett, bgamari

Subscribers: bgamari, ekmett

Differential Revision: https://phabricator.haskell.org/D2391

GHC Trac Issues: #11632
parent 24f5f368
......@@ -229,7 +229,13 @@ lex s = readP_to_S L.hsLex s
--
lexLitChar :: ReadS String -- As defined by H2010
lexLitChar = readP_to_S (do { (s, _) <- P.gather L.lexChar ;
return s })
let s' = removeNulls s in
return s' })
where
-- remove nulls from end of the character if they exist
removeNulls [] = []
removeNulls ('\\':'&':xs) = removeNulls xs
removeNulls (first:rest) = first : removeNulls rest
-- There was a skipSpaces before the P.gather L.lexChar,
-- but that seems inconsistent with readLitChar
......
......@@ -253,7 +253,16 @@ lexLitChar =
return (Char c)
lexChar :: ReadP Char
lexChar = do { (c,_) <- lexCharE; return c }
lexChar = do { (c,_) <- lexCharE; consumeEmpties; return c }
where
-- Consumes the string "\&" repeatedly and greedily (will only produce one match)
consumeEmpties :: ReadP ()
consumeEmpties = do
rest <- look
case rest of
('\\':'&':_) -> string "\\&" >> consumeEmpties
_ -> return ()
lexCharE :: ReadP (Char, Bool) -- "escaped or not"?
lexCharE =
......
......@@ -9,4 +9,7 @@ main =
putStrLn (show $ readLitChar "'A'")
putStrLn (show $ lexLitChar "A")
putStrLn (show $ lexLitChar "'A'")
putStrLn (show $ lexLitChar "\\243\\&1")
putStrLn (show $ lexLitChar "a\\&1")
putStrLn (show $ lexLitChar "a\\&\\&1")
putStrLn (show $ lexLitChar "a\\&\\&")
......@@ -2,3 +2,7 @@
[('\'',"A'")]
[("A","")]
[("'","A'")]
[("\\243","1")]
[("a","1")]
[("a","1")]
[("a","")]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment