[Git][ghc/ghc][wip/az/T22919-module-where] EPA: Comment between module and where should be in header comments
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Tue Feb 7 20:03:04 UTC 2023
Alan Zimmerman pushed to branch wip/az/T22919-module-where at Glasgow Haskell Compiler / GHC
Commits:
f6f2a65a by Alan Zimmerman at 2023-02-07T20:01:57+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
- - - - -
8 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/ZeroWidthSemi.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
=====================================
@@ -3701,11 +3701,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,116 @@
+
+==================== 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)
+ []
+ [])
+ (Just
+ ((,)
+ { T22919.hs:3:1 }
+ { T22919.hs:2:7-9 })))
+ (EpaCommentsBalanced
+ [(L
+ (Anchor
+ { T22919.hs:1:15-27 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaBlockComment
+ "{- comment -}")
+ { T22919.hs:1:8-13 }))]
+ []))
+ (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
=====================================
@@ -23,7 +23,14 @@
{ Test20239.hs:8:1 }
{ Test20239.hs:7:34-63 })))
(EpaCommentsBalanced
- []
+ [(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 }
@@ -50,14 +57,7 @@
(AnnListItem
[])
(EpaComments
- [(L
- (Anchor
- { Test20239.hs:3:1-28 }
- (UnchangedAnchor))
- (EpaComment
- (EpaLineComment
- "-- | Leading Haddock Comment")
- { Test20239.hs:1:18-22 }))])) { Test20239.hs:(4,1)-(6,86) })
+ [])) { Test20239.hs:(4,1)-(6,86) })
(InstD
(NoExtField)
(DataFamInstD
@@ -323,5 +323,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/ZeroWidthSemi.stderr
=====================================
@@ -30,7 +30,15 @@
(EpaComment
(EpaLineComment
"-- leading comments")
- { ZeroWidthSemi.hs:1:22-26 }))]
+ { ZeroWidthSemi.hs:1:22-26 }))
+ ,(L
+ (Anchor
+ { ZeroWidthSemi.hs:5:1-19 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaLineComment
+ "-- Function comment")
+ { ZeroWidthSemi.hs:3:1-19 }))]
[(L
(Anchor
{ ZeroWidthSemi.hs:8:1-58 }
@@ -57,14 +65,7 @@
(AnnListItem
[])
(EpaComments
- [(L
- (Anchor
- { ZeroWidthSemi.hs:5:1-19 }
- (UnchangedAnchor))
- (EpaComment
- (EpaLineComment
- "-- Function comment")
- { ZeroWidthSemi.hs:3:1-19 }))])) { ZeroWidthSemi.hs:6:1-5 })
+ [])) { ZeroWidthSemi.hs:6:1-5 })
(ValD
(NoExtField)
(FunBind
=====================================
testsuite/tests/ghc-api/exactprint/all.T
=====================================
@@ -38,3 +38,4 @@ 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('ZeroWidthSemi', normal, compile, ['-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
=====================================
@@ -21,8 +21,8 @@
[])
(Just
((,)
- { DumpParsedAstComments.hs:17:1 }
- { DumpParsedAstComments.hs:16:17-23 })))
+ { DumpParsedAstComments.hs:20:1 }
+ { DumpParsedAstComments.hs:19:17-23 })))
(EpaCommentsBalanced
[(L
(Anchor
@@ -42,12 +42,20 @@
{ 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 }))]
[]))
(VirtualBraces
(1))
@@ -62,55 +70,139 @@
[(L
(SrcSpanAnn (EpAnn
(Anchor
- { DumpParsedAstComments.hs:(11,1)-(13,3) }
+ { DumpParsedAstComments.hs:9:1-7 }
+ (UnchangedAnchor))
+ (AnnListItem
+ [])
+ (EpaComments
+ [])) { 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: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
- }))])) { DumpParsedAstComments.hs:(11,1)-(13,3) })
+ { DumpParsedAstComments.hs:12:1-20
+ }))])) { 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)
@@ -122,72 +214,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
@@ -206,45 +298,45 @@
,(L
(SrcSpanAnn (EpAnn
(Anchor
- { DumpParsedAstComments.hs:16:1-23 }
+ { DumpParsedAstComments.hs:19:1-23 }
(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:16:1-23 })
+ { DumpParsedAstComments.hs:16:3
+ }))])) { 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)
@@ -256,42 +348,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/f6f2a65a8200a043c5590ca35fc3a0b36728c5ca
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6f2a65a8200a043c5590ca35fc3a0b36728c5ca
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/20230207/7e9f9388/attachment-0001.html>
More information about the ghc-commits
mailing list