diff options
-rw-r--r-- | compiler/parser/Lexer.x | 6 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations-literals/literals.stdout | 2 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/CommentsTest.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/comments.stdout | 22 |
4 files changed, 17 insertions, 15 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index e451b5ffea..1be724526f 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -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 diff --git a/testsuite/tests/ghc-api/annotations-literals/literals.stdout b/testsuite/tests/ghc-api/annotations-literals/literals.stdout index ded26dadcd..ff4f63f183 100644 --- a/testsuite/tests/ghc-api/annotations-literals/literals.stdout +++ b/testsuite/tests/ghc-api/annotations-literals/literals.stdout @@ -1,4 +1,4 @@ -(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]), diff --git a/testsuite/tests/ghc-api/annotations/CommentsTest.hs b/testsuite/tests/ghc-api/annotations/CommentsTest.hs index ce0f336d39..c6cf79c5da 100644 --- a/testsuite/tests/ghc-api/annotations/CommentsTest.hs +++ b/testsuite/tests/ghc-api/annotations/CommentsTest.hs @@ -2,6 +2,8 @@ module CommentsTest (foo) where {- An opening comment + {- with a nested one -} + {-# nested PRAGMA #-} -} import qualified Data.List as DL diff --git a/testsuite/tests/ghc-api/annotations/comments.stdout b/testsuite/tests/ghc-api/annotations/comments.stdout index 25cf55557c..06273ba1e6 100644 --- a/testsuite/tests/ghc-api/annotations/comments.stdout +++ b/testsuite/tests/ghc-api/annotations/comments.stdout @@ -1,25 +1,25 @@ [ -( 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 #-}")]) ] |