[commit: ghc] master: Bugfix for bug 11632: `readLitChar` should consume null characters (0f0cdb6)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/0f0cdb6827803015a9a3924fdafaef8dbcde048f/ghc

>---------------------------------------------------------------

commit 0f0cdb6827803015a9a3924fdafaef8dbcde048f
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Sun Jul 17 00:12:52 2016 +0200

    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


>---------------------------------------------------------------

0f0cdb6827803015a9a3924fdafaef8dbcde048f
 libraries/base/GHC/Read.hs              |  8 +++++++-
 libraries/base/Text/Read/Lex.hs         | 11 ++++++++++-
 libraries/base/tests/readLitChar.hs     |  5 ++++-
 libraries/base/tests/readLitChar.stdout |  4 ++++
 4 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/libraries/base/GHC/Read.hs b/libraries/base/GHC/Read.hs
index 54fbc28..d7df82f 100644
--- a/libraries/base/GHC/Read.hs
+++ b/libraries/base/GHC/Read.hs
@@ -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
 
diff --git a/libraries/base/Text/Read/Lex.hs b/libraries/base/Text/Read/Lex.hs
index 7054be9..d0d39c6 100644
--- a/libraries/base/Text/Read/Lex.hs
+++ b/libraries/base/Text/Read/Lex.hs
@@ -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 =
diff --git a/libraries/base/tests/readLitChar.hs b/libraries/base/tests/readLitChar.hs
index 7dc01e3..e287d22 100644
--- a/libraries/base/tests/readLitChar.hs
+++ b/libraries/base/tests/readLitChar.hs
@@ -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\\&\\&")
diff --git a/libraries/base/tests/readLitChar.stdout b/libraries/base/tests/readLitChar.stdout
index 649c342..db7bc5b 100644
--- a/libraries/base/tests/readLitChar.stdout
+++ b/libraries/base/tests/readLitChar.stdout
@@ -2,3 +2,7 @@
 [('\'',"A'")]
 [("A","")]
 [("'","A'")]
+[("\\243","1")]
+[("a","1")]
+[("a","1")]
+[("a","")]