diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index a116aec66cdc8bf30d288f17179d69e030335028..dfccebce86d63ce5fc416d0b25a5ae3a5335a481 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -3676,6 +3676,25 @@ allocateComments ss comment_q =
in
(comment_q', reverse newAnns)
+-- Comments appearing without a line-break before the first
+-- declaration are associated with the declaration
+splitPriorComments
+ :: RealSrcSpan
+ -> [LEpaComment]
+ -> ([LEpaComment], [LEpaComment])
+splitPriorComments ss prior_comments =
+ let
+ -- True if there is only one line between the earlier and later span
+ cmp later earlier
+ = srcSpanStartLine later - srcSpanEndLine earlier == 1
+
+ go decl _ [] = ([],decl)
+ go decl r (c@(L l _):cs) = if cmp r (anchor l)
+ then go (c:decl) (anchor l) cs
+ else (reverse (c:cs), decl)
+ in
+ go [] ss prior_comments
+
allocatePriorComments
:: RealSrcSpan
-> [LEpaComment]
@@ -3684,12 +3703,13 @@ allocatePriorComments
allocatePriorComments ss comment_q mheader_comments =
let
cmp (L l _) = anchor l <= ss
- (before,after) = partition cmp comment_q
- newAnns = before
+ (newAnns,after) = partition cmp comment_q
comment_q'= after
+ (prior_comments, decl_comments) = splitPriorComments ss newAnns
in
case mheader_comments of
- Strict.Nothing -> (Strict.Just (reverse newAnns), comment_q', [])
+ 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
diff --git a/testsuite/tests/ghc-api/exactprint/Test20239.stderr b/testsuite/tests/ghc-api/exactprint/Test20239.stderr
index 2bac5ab5320f675f247d29b9863cad23df727054..bcbb818b05418cea55bb9df860ff44b11ec64107 100644
--- a/testsuite/tests/ghc-api/exactprint/Test20239.stderr
+++ b/testsuite/tests/ghc-api/exactprint/Test20239.stderr
@@ -19,14 +19,7 @@
[]
[]))
(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 }
@@ -53,6 +46,14 @@
[])
(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))
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAstComments.hs b/testsuite/tests/parser/should_compile/DumpParsedAstComments.hs
index d7c51b23b14086b6c36d2524e6842fe0beeb9a9b..62dc878213ccbe91a9163067b8b1a6ad9d8a98a9 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAstComments.hs
+++ b/testsuite/tests/parser/should_compile/DumpParsedAstComments.hs
@@ -4,6 +4,10 @@
-}
module DumpParsedAstComments where
+-- Other comment
+
+-- comment 1 for foo
+-- comment 2 for foo
foo = do
-- normal comment
1
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr b/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
index d453ae5de1c487a01387feced1d8a1e40db2cf53..0f451eeb1498a2250c7625b1ff8cf0988115d935 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
@@ -34,15 +34,23 @@
(UnchangedAnchor))
(EpaComment
(EpaBlockComment
- "{-\n Block comment at the beginning\n -}")
- { DumpParsedAstComments.hs:1:1-28 }))]
+ "{-/n Block comment at the beginning/n -}")
+ { DumpParsedAstComments.hs:1:1-28 }))
+ ,(L
+ (Anchor
+ { DumpParsedAstComments.hs:7:1-16 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaLineComment
+ "-- Other comment")
+ { DumpParsedAstComments.hs:5:30-34 }))]
[(L
(Anchor
- { DumpParsedAstComments.hs:13:1 }
+ { DumpParsedAstComments.hs:17:1 }
(UnchangedAnchor))
(EpaComment
(EpaEofComment)
- { DumpParsedAstComments.hs:13:1 }))]))
+ { DumpParsedAstComments.hs:17:1 }))]))
(VirtualBraces
(1))
(Nothing)
@@ -56,47 +64,63 @@
[(L
(SrcSpanAnn (EpAnn
(Anchor
- { DumpParsedAstComments.hs:(7,1)-(9,3) }
+ { DumpParsedAstComments.hs:(11,1)-(13,3) }
(UnchangedAnchor))
(AnnListItem
[])
(EpaComments
[(L
(Anchor
- { DumpParsedAstComments.hs:11:1-20 }
+ { DumpParsedAstComments.hs:9:1-20 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaLineComment
+ "-- comment 1 for foo")
+ { DumpParsedAstComments.hs:7:1-16 }))
+ ,(L
+ (Anchor
+ { DumpParsedAstComments.hs:10:1-20 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaLineComment
+ "-- comment 2 for foo")
+ { DumpParsedAstComments.hs:9:1-20 }))
+ ,(L
+ (Anchor
+ { DumpParsedAstComments.hs:15:1-20 }
(UnchangedAnchor))
(EpaComment
(EpaLineComment
"-- | Haddock comment")
- { DumpParsedAstComments.hs:9:3
- }))])) { DumpParsedAstComments.hs:(7,1)-(9,3) })
+ { DumpParsedAstComments.hs:13:3
+ }))])) { DumpParsedAstComments.hs:(11,1)-(13,3) })
(ValD
(NoExtField)
(FunBind
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:7:1-3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 })
(Unqual
{OccName: foo}))
(MG
(FromSource)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(7,1)-(9,3)
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3)
})
[(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(7,1)-(9,3)
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3)
})
(Match
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:(7,1)-(9,3) }
+ { DumpParsedAstComments.hs:(11,1)-(13,3) }
(UnchangedAnchor))
[]
(EpaComments
[]))
(FunRhs
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:7:1-3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 })
(Unqual
{OccName: foo}))
(Prefix)
@@ -108,72 +132,72 @@
[(L
(SrcSpanAnn
(EpAnnNotUsed)
- { DumpParsedAstComments.hs:(7,5)-(9,3) })
+ { DumpParsedAstComments.hs:(11,5)-(13,3) })
(GRHS
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:(7,5)-(9,3) }
+ { DumpParsedAstComments.hs:(11,5)-(13,3) }
(UnchangedAnchor))
(GrhsAnn
(Nothing)
- (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:7:5 })))
+ (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:11:5 })))
(EpaComments
[]))
[]
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(7,7)-(9,3)
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,7)-(13,3)
})
(HsDo
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:(7,7)-(9,3) }
+ { DumpParsedAstComments.hs:(11,7)-(13,3) }
(UnchangedAnchor))
(AnnList
(Just
(Anchor
- { DumpParsedAstComments.hs:9:3 }
+ { DumpParsedAstComments.hs:13:3 }
(UnchangedAnchor)))
(Nothing)
(Nothing)
- [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:7:7-8 }))]
+ [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:11:7-8 }))]
[])
(EpaComments
[(L
(Anchor
- { DumpParsedAstComments.hs:8:3-19 }
+ { DumpParsedAstComments.hs:12:3-19 }
(UnchangedAnchor))
(EpaComment
(EpaLineComment
"-- normal comment")
- { DumpParsedAstComments.hs:7:7-8 }))]))
+ { DumpParsedAstComments.hs:11:7-8 }))]))
(DoExpr
(Nothing))
(L
(SrcSpanAnn (EpAnn
(Anchor
- { DumpParsedAstComments.hs:9:3 }
+ { DumpParsedAstComments.hs:13:3 }
(UnchangedAnchor))
(AnnList
(Just
(Anchor
- { DumpParsedAstComments.hs:9:3 }
+ { DumpParsedAstComments.hs:13:3 }
(UnchangedAnchor)))
(Nothing)
(Nothing)
[]
[])
(EpaComments
- [])) { DumpParsedAstComments.hs:9:3 })
+ [])) { DumpParsedAstComments.hs:13:3 })
[(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 })
(BodyStmt
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 })
(HsOverLit
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:9:3 }
+ { DumpParsedAstComments.hs:13:3 }
(UnchangedAnchor))
(NoEpAnns)
(EpaComments
@@ -192,37 +216,37 @@
,(L
(SrcSpanAnn (EpAnn
(Anchor
- { DumpParsedAstComments.hs:12:1-23 }
+ { DumpParsedAstComments.hs:16:1-23 }
(UnchangedAnchor))
(AnnListItem
[])
(EpaComments
- [])) { DumpParsedAstComments.hs:12:1-23 })
+ [])) { DumpParsedAstComments.hs:16:1-23 })
(ValD
(NoExtField)
(FunBind
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:1-4 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 })
(Unqual
{OccName: main}))
(MG
(FromSource)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:1-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 })
[(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:1-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 })
(Match
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:12:1-23 }
+ { DumpParsedAstComments.hs:16:1-23 }
(UnchangedAnchor))
[]
(EpaComments
[]))
(FunRhs
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:1-4 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 })
(Unqual
{OccName: main}))
(Prefix)
@@ -234,42 +258,42 @@
[(L
(SrcSpanAnn
(EpAnnNotUsed)
- { DumpParsedAstComments.hs:12:6-23 })
+ { DumpParsedAstComments.hs:16:6-23 })
(GRHS
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:12:6-23 }
+ { DumpParsedAstComments.hs:16:6-23 }
(UnchangedAnchor))
(GrhsAnn
(Nothing)
- (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:12:6 })))
+ (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:16:6 })))
(EpaComments
[]))
[]
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:8-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-23 })
(HsApp
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:12:8-23 }
+ { DumpParsedAstComments.hs:16:8-23 }
(UnchangedAnchor))
(NoEpAnns)
(EpaComments
[]))
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:8-15 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 })
(HsVar
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:8-15 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 })
(Unqual
{OccName: putStrLn}))))
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:17-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:17-23 })
(HsLit
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:12:17-23 }
+ { DumpParsedAstComments.hs:16:17-23 }
(UnchangedAnchor))
(NoEpAnns)
(EpaComments
diff --git a/testsuite/tests/printer/Ppr031.hs b/testsuite/tests/printer/Ppr031.hs
index b31896a9fce21740944c00d3ca91fefde59379f3..78396c4220cc7049cdf7a264f8b9812e9df79f70 100644
--- a/testsuite/tests/printer/Ppr031.hs
+++ b/testsuite/tests/printer/Ppr031.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE ImplicitParams, NamedFieldPuns, ParallelListComp, PatternGuards #-}
+
spec :: Spec
spec = do
describe "split4'8" $ do