diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2023-02-06 22:58:39 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-02-08 18:42:51 -0500 |
commit | f22cce70dc7b9da191a023a9677eaea491bb2688 (patch) | |
tree | 2c86b3ec052594b1f2d14daca31f5f6ccf275676 | |
parent | ca6673e3cab496bbeed2ced47b40bcf1e0d0b3cd (diff) | |
download | haskell-f22cce70dc7b9da191a023a9677eaea491bb2688.tar.gz |
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
-rw-r--r-- | compiler/GHC/Parser/Lexer.x | 6 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/exactprint/T22919.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/exactprint/T22919.stderr | 116 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/exactprint/Test20239.stderr | 20 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr | 19 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/exactprint/all.T | 1 | ||||
-rw-r--r-- | testsuite/tests/parser/should_compile/DumpParsedAstComments.hs | 3 | ||||
-rw-r--r-- | testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr | 190 |
8 files changed, 287 insertions, 70 deletions
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x index 407aa93280..1fd2c5b663 100644 --- a/compiler/GHC/Parser/Lexer.x +++ b/compiler/GHC/Parser/Lexer.x @@ -3700,11 +3700,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 diff --git a/testsuite/tests/ghc-api/exactprint/T22919.hs b/testsuite/tests/ghc-api/exactprint/T22919.hs new file mode 100644 index 0000000000..3c627f1278 --- /dev/null +++ b/testsuite/tests/ghc-api/exactprint/T22919.hs @@ -0,0 +1,2 @@ +module T22919 {- comment -} where +foo = 's' diff --git a/testsuite/tests/ghc-api/exactprint/T22919.stderr b/testsuite/tests/ghc-api/exactprint/T22919.stderr new file mode 100644 index 0000000000..eb4c9c9a4c --- /dev/null +++ b/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)))))])))))])) diff --git a/testsuite/tests/ghc-api/exactprint/Test20239.stderr b/testsuite/tests/ghc-api/exactprint/Test20239.stderr index b89a29fbf2..cfe514f31e 100644 --- a/testsuite/tests/ghc-api/exactprint/Test20239.stderr +++ b/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’ diff --git a/testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr b/testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr index 13937cd36b..45640ba26e 100644 --- a/testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr +++ b/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 diff --git a/testsuite/tests/ghc-api/exactprint/all.T b/testsuite/tests/ghc-api/exactprint/all.T index 825d57c339..6bbb5807c2 100644 --- a/testsuite/tests/ghc-api/exactprint/all.T +++ b/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']) diff --git a/testsuite/tests/parser/should_compile/DumpParsedAstComments.hs b/testsuite/tests/parser/should_compile/DumpParsedAstComments.hs index 62dc878213..e906e6f2cb 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAstComments.hs +++ b/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 diff --git a/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr b/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr index 4eb1a179db..5990fb171a 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr +++ b/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 |