Commit 5fded20c authored by Alan Zimmerman's avatar Alan Zimmerman Committed by Austin Seipp

ApiAnnotations : lexer discards comment close in nested comment

When parsing a nested comment, such as

{-
  {-  nested comment  -}
  {-# nested pragma  #-}
-}

The lexer returns the comment annotation as

{-
  {-  nested comment
  {-# nested pragma  #
-}

Restore the missing comment end markers in the annotation.

Reviewed By: austin

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

GHC Trac Issues: #10277
parent 8dc29448
......@@ -970,7 +970,7 @@ lineCommentToken span buf len = do
nested_comment :: P (RealLocated Token) -> Action
nested_comment cont span buf len = do
input <- getInput
go (reverse $ drop 2 $ lexemeToString buf len) (1::Int) input
go (reverse $ lexemeToString buf len) (1::Int) input
where
go commentAcc 0 input = do
setInput input
......@@ -982,9 +982,9 @@ nested_comment cont span buf len = do
Nothing -> errBrace input span
Just ('-',input) -> case alexGetChar' input of
Nothing -> errBrace input span
Just ('\125',input) -> go commentAcc (n-1) input
Just ('\125',input) -> go ('\125':'-':commentAcc) (n-1) input -- '}'
Just (_,_) -> go ('-':commentAcc) n input
Just ('\123',input) -> case alexGetChar' input of
Just ('\123',input) -> case alexGetChar' input of -- '{' char
Nothing -> errBrace input span
Just ('-',input) -> go ('-':'\123':commentAcc) (n+1) input
Just (_,_) -> go ('\123':commentAcc) n input
......
(LiteralsTest.hs:1:1-26,ITblockComment "# LANGUAGE MagicHash #",[{-# LANGUAGE MagicHash #-}]),
(LiteralsTest.hs:1:1-26,ITblockComment "{-# LANGUAGE MagicHash #-}",[{-# LANGUAGE MagicHash #-}]),
(LiteralsTest.hs:2:1-6,ITmodule,[module]),
......
......@@ -2,6 +2,8 @@
module CommentsTest (foo) where
{-
An opening comment
{- with a nested one -}
{-# nested PRAGMA #-}
-}
import qualified Data.List as DL
......
[
( CommentsTest.hs:9:1-33 =
[(CommentsTest.hs:9:1-33,AnnDocCommentNext " The function @foo@ does blah")])
( CommentsTest.hs:11:1-33 =
[(CommentsTest.hs:11:1-33,AnnDocCommentNext " The function @foo@ does blah")])
( CommentsTest.hs:(10,7)-(13,14) =
[(CommentsTest.hs:12:15-24,AnnLineComment "-- value 2")])
( CommentsTest.hs:(12,7)-(15,14) =
[(CommentsTest.hs:14:15-24,AnnLineComment "-- value 2")])
( <no location info> =
[(CommentsTest.hs:(3,1)-(5,2),AnnBlockComment "\nAn opening comment\n"),
[(CommentsTest.hs:(3,1)-(7,2),AnnBlockComment "{-\nAn opening comment\n {- with a nested one -}\n {-# nested PRAGMA #-}\n-}"),
(CommentsTest.hs:1:1-31,AnnBlockComment "# LANGUAGE DeriveFoldable #")])
(CommentsTest.hs:1:1-31,AnnBlockComment "{-# LANGUAGE DeriveFoldable #-}")])
]
[
( CommentsTest.hs:(10,7)-(13,14) =
[(CommentsTest.hs:12:15-24,AnnLineComment "-- value 2")])
( CommentsTest.hs:(12,7)-(15,14) =
[(CommentsTest.hs:14:15-24,AnnLineComment "-- value 2")])
( <no location info> =
[(CommentsTest.hs:9:1-33,AnnLineComment "-- | The function @foo@ does blah"),
[(CommentsTest.hs:11:1-33,AnnLineComment "-- | The function @foo@ does blah"),
(CommentsTest.hs:(3,1)-(5,2),AnnBlockComment "\nAn opening comment\n"),
(CommentsTest.hs:(3,1)-(7,2),AnnBlockComment "{-\nAn opening comment\n {- with a nested one -}\n {-# nested PRAGMA #-}\n-}"),
(CommentsTest.hs:1:1-31,AnnBlockComment "# LANGUAGE DeriveFoldable #")])
(CommentsTest.hs:1:1-31,AnnBlockComment "{-# LANGUAGE DeriveFoldable #-}")])
]
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