[Git][ghc/ghc][ghc-9.6] EPA: Comment between module and where should be in header comments
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Wed Feb 15 07:53:50 UTC 2023
Ben Gamari pushed to branch ghc-9.6 at Glasgow Haskell Compiler / GHC
Commits:
2ad167bf by Alan Zimmerman at 2023-02-14T20:53:26+00:00
EPA: Comment between module and where should be in header comments
Do not apply the heuristic to associate a comment with a prior
declaration for the first declaration in the file.
Closes #22919
(cherry picked from commit f22cce70dc7b9da191a023a9677eaea491bb2688)
- - - - -
7 changed files:
- compiler/GHC/Parser/Lexer.x
- + testsuite/tests/ghc-api/exactprint/T22919.hs
- + testsuite/tests/ghc-api/exactprint/T22919.stderr
- testsuite/tests/ghc-api/exactprint/Test20239.stderr
- testsuite/tests/ghc-api/exactprint/all.T
- testsuite/tests/parser/should_compile/DumpParsedAstComments.hs
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
Changes:
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -3713,11 +3713,13 @@ allocatePriorComments ss comment_q mheader_comments =
cmp (L l _) = anchor l <= ss
(newAnns,after) = partition cmp comment_q
comment_q'= after
- (prior_comments, decl_comments) = splitPriorComments ss newAnns
+ (prior_comments, decl_comments)
+ = case mheader_comments of
+ Strict.Nothing -> (reverse newAnns, [])
+ _ -> splitPriorComments ss newAnns
in
case mheader_comments of
Strict.Nothing -> (Strict.Just prior_comments, comment_q', decl_comments)
- -- Strict.Nothing -> (Strict.Just [], comment_q', newAnns)
Strict.Just _ -> (mheader_comments, comment_q', reverse newAnns)
allocateFinalComments
=====================================
testsuite/tests/ghc-api/exactprint/T22919.hs
=====================================
@@ -0,0 +1,2 @@
+module T22919 {- comment -} where
+foo = 's'
=====================================
testsuite/tests/ghc-api/exactprint/T22919.stderr
=====================================
@@ -0,0 +1,118 @@
+
+==================== Parser AST ====================
+
+(L
+ { T22919.hs:1:1 }
+ (HsModule
+ (XModulePs
+ (EpAnn
+ (Anchor
+ { T22919.hs:1:1 }
+ (UnchangedAnchor))
+ (AnnsModule
+ [(AddEpAnn AnnModule (EpaSpan { T22919.hs:1:1-6 }))
+ ,(AddEpAnn AnnWhere (EpaSpan { T22919.hs:1:29-33 }))]
+ (AnnList
+ (Nothing)
+ (Nothing)
+ (Nothing)
+ []
+ []))
+ (EpaCommentsBalanced
+ [(L
+ (Anchor
+ { T22919.hs:1:15-27 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaBlockComment
+ "{- comment -}")
+ { T22919.hs:1:8-13 }))]
+ [(L
+ (Anchor
+ { T22919.hs:3:1 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaEofComment)
+ { T22919.hs:3:1 }))]))
+ (VirtualBraces
+ (1))
+ (Nothing)
+ (Nothing))
+ (Just
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:1:8-13 })
+ {ModuleName: T22919}))
+ (Nothing)
+ []
+ [(L
+ (SrcSpanAnn (EpAnn
+ (Anchor
+ { T22919.hs:2:1-9 }
+ (UnchangedAnchor))
+ (AnnListItem
+ [])
+ (EpaComments
+ [])) { T22919.hs:2:1-9 })
+ (ValD
+ (NoExtField)
+ (FunBind
+ (NoExtField)
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 })
+ (Unqual
+ {OccName: foo}))
+ (MG
+ (FromSource)
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 })
+ [(L
+ (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-9 })
+ (Match
+ (EpAnn
+ (Anchor
+ { T22919.hs:2:1-9 }
+ (UnchangedAnchor))
+ []
+ (EpaComments
+ []))
+ (FunRhs
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:1-3 })
+ (Unqual
+ {OccName: foo}))
+ (Prefix)
+ (NoSrcStrict))
+ []
+ (GRHSs
+ (EpaComments
+ [])
+ [(L
+ (SrcSpanAnn
+ (EpAnnNotUsed)
+ { T22919.hs:2:5-9 })
+ (GRHS
+ (EpAnn
+ (Anchor
+ { T22919.hs:2:5-9 }
+ (UnchangedAnchor))
+ (GrhsAnn
+ (Nothing)
+ (AddEpAnn AnnEqual (EpaSpan { T22919.hs:2:5 })))
+ (EpaComments
+ []))
+ []
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { T22919.hs:2:7-9 })
+ (HsLit
+ (EpAnn
+ (Anchor
+ { T22919.hs:2:7-9 }
+ (UnchangedAnchor))
+ (NoEpAnns)
+ (EpaComments
+ []))
+ (HsChar
+ (SourceText 's')
+ ('s'))))))]
+ (EmptyLocalBinds
+ (NoExtField)))))])))))]))
=====================================
testsuite/tests/ghc-api/exactprint/Test20239.stderr
=====================================
@@ -19,7 +19,14 @@
[]
[]))
(EpaCommentsBalanced
- []
+ [(L
+ (Anchor
+ { Test20239.hs:3:1-28 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaLineComment
+ "-- | Leading Haddock Comment")
+ { Test20239.hs:1:18-22 }))]
[(L
(Anchor
{ Test20239.hs:8:1 }
@@ -46,14 +53,6 @@
[])
(EpaComments
[(L
- (Anchor
- { Test20239.hs:3:1-28 }
- (UnchangedAnchor))
- (EpaComment
- (EpaLineComment
- "-- | Leading Haddock Comment")
- { Test20239.hs:1:18-22 }))
- ,(L
(Anchor
{ Test20239.hs:7:34-63 }
(UnchangedAnchor))
@@ -326,5 +325,5 @@
-Test20239.hs:4:15: error: [GHC-76037]
+Test20239.hs:4:15: [GHC-76037]
Not in scope: type constructor or class ‘Method’
=====================================
testsuite/tests/ghc-api/exactprint/all.T
=====================================
@@ -37,3 +37,4 @@ test('RmTypeSig2', ignore_stderr, makefile_test, ['RmTypeSig2'])
test('AddHiding1', ignore_stderr, makefile_test, ['AddHiding1'])
test('AddHiding2', ignore_stderr, makefile_test, ['AddHiding2'])
test('Test20239', normal, compile_fail, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments'])
+test('T22919', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments'])
=====================================
testsuite/tests/parser/should_compile/DumpParsedAstComments.hs
=====================================
@@ -4,6 +4,9 @@
-}
module DumpParsedAstComments where
+-- comment 1 for bar
+-- comment 2 for bar
+bar = 1
-- Other comment
-- comment 1 for foo
=====================================
testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
=====================================
@@ -38,19 +38,27 @@
{ DumpParsedAstComments.hs:1:1-28 }))
,(L
(Anchor
- { DumpParsedAstComments.hs:7:1-16 }
+ { DumpParsedAstComments.hs:7:1-20 }
(UnchangedAnchor))
(EpaComment
(EpaLineComment
- "-- Other comment")
- { DumpParsedAstComments.hs:5:30-34 }))]
+ "-- comment 1 for bar")
+ { DumpParsedAstComments.hs:5:30-34 }))
+ ,(L
+ (Anchor
+ { DumpParsedAstComments.hs:8:1-20 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaLineComment
+ "-- comment 2 for bar")
+ { DumpParsedAstComments.hs:7:1-20 }))]
[(L
(Anchor
- { DumpParsedAstComments.hs:17:1 }
+ { DumpParsedAstComments.hs:20:1 }
(UnchangedAnchor))
(EpaComment
(EpaEofComment)
- { DumpParsedAstComments.hs:17:1 }))]))
+ { DumpParsedAstComments.hs:20:1 }))]))
(VirtualBraces
(1))
(Nothing)
@@ -64,63 +72,147 @@
[(L
(SrcSpanAnn (EpAnn
(Anchor
- { DumpParsedAstComments.hs:(11,1)-(13,3) }
+ { DumpParsedAstComments.hs:9:1-7 }
(UnchangedAnchor))
(AnnListItem
[])
(EpaComments
[(L
(Anchor
- { DumpParsedAstComments.hs:9:1-20 }
+ { DumpParsedAstComments.hs:10:1-16 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaLineComment
+ "-- Other comment")
+ { DumpParsedAstComments.hs:9:7 }))
+ ,(L
+ (Anchor
+ { DumpParsedAstComments.hs:12:1-20 }
(UnchangedAnchor))
(EpaComment
(EpaLineComment
"-- comment 1 for foo")
- { DumpParsedAstComments.hs:7:1-16 }))
+ { DumpParsedAstComments.hs:10:1-16 }))
,(L
(Anchor
- { DumpParsedAstComments.hs:10:1-20 }
+ { DumpParsedAstComments.hs:13:1-20 }
(UnchangedAnchor))
(EpaComment
(EpaLineComment
"-- comment 2 for foo")
- { DumpParsedAstComments.hs:9:1-20 }))
- ,(L
+ { DumpParsedAstComments.hs:12:1-20
+ }))])) { DumpParsedAstComments.hs:9:1-7 })
+ (ValD
+ (NoExtField)
+ (FunBind
+ (NoExtField)
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 })
+ (Unqual
+ {OccName: bar}))
+ (MG
+ (FromSource)
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 })
+ [(L
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-7 })
+ (Match
+ (EpAnn
+ (Anchor
+ { DumpParsedAstComments.hs:9:1-7 }
+ (UnchangedAnchor))
+ []
+ (EpaComments
+ []))
+ (FunRhs
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:1-3 })
+ (Unqual
+ {OccName: bar}))
+ (Prefix)
+ (NoSrcStrict))
+ []
+ (GRHSs
+ (EpaComments
+ [])
+ [(L
+ (SrcSpanAnn
+ (EpAnnNotUsed)
+ { DumpParsedAstComments.hs:9:5-7 })
+ (GRHS
+ (EpAnn
+ (Anchor
+ { DumpParsedAstComments.hs:9:5-7 }
+ (UnchangedAnchor))
+ (GrhsAnn
+ (Nothing)
+ (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:9:5 })))
+ (EpaComments
+ []))
+ []
+ (L
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:7 })
+ (HsOverLit
+ (EpAnn
+ (Anchor
+ { DumpParsedAstComments.hs:9:7 }
+ (UnchangedAnchor))
+ (NoEpAnns)
+ (EpaComments
+ []))
+ (OverLit
+ (NoExtField)
+ (HsIntegral
+ (IL
+ (SourceText 1)
+ (False)
+ (1))))))))]
+ (EmptyLocalBinds
+ (NoExtField)))))])))))
+ ,(L
+ (SrcSpanAnn (EpAnn
+ (Anchor
+ { DumpParsedAstComments.hs:(14,1)-(16,3) }
+ (UnchangedAnchor))
+ (AnnListItem
+ [])
+ (EpaComments
+ [(L
(Anchor
- { DumpParsedAstComments.hs:15:1-20 }
+ { DumpParsedAstComments.hs:18:1-20 }
(UnchangedAnchor))
(EpaComment
(EpaLineComment
"-- | Haddock comment")
- { DumpParsedAstComments.hs:13:3
- }))])) { DumpParsedAstComments.hs:(11,1)-(13,3) })
+ { DumpParsedAstComments.hs:16:3
+ }))])) { DumpParsedAstComments.hs:(14,1)-(16,3) })
(ValD
(NoExtField)
(FunBind
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 })
(Unqual
{OccName: foo}))
(MG
(FromSource)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3)
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3)
})
[(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3)
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,1)-(16,3)
})
(Match
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:(11,1)-(13,3) }
+ { DumpParsedAstComments.hs:(14,1)-(16,3) }
(UnchangedAnchor))
[]
(EpaComments
[]))
(FunRhs
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:14:1-3 })
(Unqual
{OccName: foo}))
(Prefix)
@@ -132,72 +224,72 @@
[(L
(SrcSpanAnn
(EpAnnNotUsed)
- { DumpParsedAstComments.hs:(11,5)-(13,3) })
+ { DumpParsedAstComments.hs:(14,5)-(16,3) })
(GRHS
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:(11,5)-(13,3) }
+ { DumpParsedAstComments.hs:(14,5)-(16,3) }
(UnchangedAnchor))
(GrhsAnn
(Nothing)
- (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:11:5 })))
+ (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:14:5 })))
(EpaComments
[]))
[]
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,7)-(13,3)
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(14,7)-(16,3)
})
(HsDo
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:(11,7)-(13,3) }
+ { DumpParsedAstComments.hs:(14,7)-(16,3) }
(UnchangedAnchor))
(AnnList
(Just
(Anchor
- { DumpParsedAstComments.hs:13:3 }
+ { DumpParsedAstComments.hs:16:3 }
(UnchangedAnchor)))
(Nothing)
(Nothing)
- [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:11:7-8 }))]
+ [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:14:7-8 }))]
[])
(EpaComments
[(L
(Anchor
- { DumpParsedAstComments.hs:12:3-19 }
+ { DumpParsedAstComments.hs:15:3-19 }
(UnchangedAnchor))
(EpaComment
(EpaLineComment
"-- normal comment")
- { DumpParsedAstComments.hs:11:7-8 }))]))
+ { DumpParsedAstComments.hs:14:7-8 }))]))
(DoExpr
(Nothing))
(L
(SrcSpanAnn (EpAnn
(Anchor
- { DumpParsedAstComments.hs:13:3 }
+ { DumpParsedAstComments.hs:16:3 }
(UnchangedAnchor))
(AnnList
(Just
(Anchor
- { DumpParsedAstComments.hs:13:3 }
+ { DumpParsedAstComments.hs:16:3 }
(UnchangedAnchor)))
(Nothing)
(Nothing)
[]
[])
(EpaComments
- [])) { DumpParsedAstComments.hs:13:3 })
+ [])) { DumpParsedAstComments.hs:16:3 })
[(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 })
(BodyStmt
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:3 })
(HsOverLit
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:13:3 }
+ { DumpParsedAstComments.hs:16:3 }
(UnchangedAnchor))
(NoEpAnns)
(EpaComments
@@ -216,37 +308,37 @@
,(L
(SrcSpanAnn (EpAnn
(Anchor
- { DumpParsedAstComments.hs:16:1-23 }
+ { DumpParsedAstComments.hs:19:1-23 }
(UnchangedAnchor))
(AnnListItem
[])
(EpaComments
- [])) { DumpParsedAstComments.hs:16:1-23 })
+ [])) { DumpParsedAstComments.hs:19:1-23 })
(ValD
(NoExtField)
(FunBind
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 })
(Unqual
{OccName: main}))
(MG
(FromSource)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 })
[(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-23 })
(Match
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:16:1-23 }
+ { DumpParsedAstComments.hs:19:1-23 }
(UnchangedAnchor))
[]
(EpaComments
[]))
(FunRhs
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:1-4 })
(Unqual
{OccName: main}))
(Prefix)
@@ -258,42 +350,42 @@
[(L
(SrcSpanAnn
(EpAnnNotUsed)
- { DumpParsedAstComments.hs:16:6-23 })
+ { DumpParsedAstComments.hs:19:6-23 })
(GRHS
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:16:6-23 }
+ { DumpParsedAstComments.hs:19:6-23 }
(UnchangedAnchor))
(GrhsAnn
(Nothing)
- (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:16:6 })))
+ (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:19:6 })))
(EpaComments
[]))
[]
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-23 })
(HsApp
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:16:8-23 }
+ { DumpParsedAstComments.hs:19:8-23 }
(UnchangedAnchor))
(NoEpAnns)
(EpaComments
[]))
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 })
(HsVar
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:8-15 })
(Unqual
{OccName: putStrLn}))))
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:17-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:19:17-23 })
(HsLit
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:16:17-23 }
+ { DumpParsedAstComments.hs:19:17-23 }
(UnchangedAnchor))
(NoEpAnns)
(EpaComments
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2ad167bf835b820f680bc31a69bd2c14357eca62
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2ad167bf835b820f680bc31a69bd2c14357eca62
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230215/52dec80d/attachment-0001.html>
More information about the ghc-commits
mailing list