From 99d695c7b4af6e6df4bfbc6f9316e7d0cbf28e98 Mon Sep 17 00:00:00 2001 From: Andrei Borzenkov Date: Wed, 4 Jan 2023 17:02:36 +0400 Subject: fixup! WIP: HsModuleHeaderTokens Fix tests passing for `WIP: HsModuleHeaderTokens` --- testsuite/tests/ghc-api/exactprint/Test20239.stderr | 9 +++++++++ .../haddock/should_compile_flag_haddock/T17544.stderr | 9 +++++++++ .../should_compile_flag_haddock/T17544_kw.stderr | 11 +++++++++-- testsuite/tests/module/mod185.stderr | 1 + .../tests/parser/should_compile/DumpParsedAst.stderr | 11 +++++++++-- .../should_compile/DumpParsedAstComments.stderr | 9 +++++++++ .../tests/parser/should_compile/DumpSemis.stderr | 11 +++++++++-- testsuite/tests/parser/should_compile/KindSigs.stderr | 9 +++++++++ testsuite/tests/parser/should_compile/T15323.stderr | 11 +++++++++-- testsuite/tests/parser/should_compile/T20452.stderr | 11 +++++++++-- testsuite/tests/parser/should_compile/T20718.stderr | 9 +++++++++ testsuite/tests/parser/should_compile/T20718b.stderr | 11 +++++++++-- testsuite/tests/parser/should_compile/T20846.stderr | 9 +++++++++ testsuite/tests/printer/T18791.stderr | 11 +++++++++-- testsuite/tests/printer/Test20297.stdout | 19 ++++++++++++++++++- utils/check-exact/ExactPrint.hs | 4 ++-- utils/check-exact/Transform.hs | 8 ++++---- 17 files changed, 142 insertions(+), 21 deletions(-) diff --git a/testsuite/tests/ghc-api/exactprint/Test20239.stderr b/testsuite/tests/ghc-api/exactprint/Test20239.stderr index 2bac5ab532..9520320e0e 100644 --- a/testsuite/tests/ghc-api/exactprint/Test20239.stderr +++ b/testsuite/tests/ghc-api/exactprint/Test20239.stderr @@ -38,6 +38,15 @@ (1)) (Nothing) (Nothing)) + (HsModTk + (L + (TokenLoc + (EpaSpan { Test20239.hs:1:1-6 })) + (HsTok)) + (L + (TokenLoc + (EpaSpan { Test20239.hs:1:18-22 })) + (HsTok))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:1:8-16 }) diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr index 335d76247a..f99b23e9c0 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr @@ -31,6 +31,15 @@ (1)) (Nothing) (Nothing)) + (HsModTk + (L + (TokenLoc + (EpaSpan { T17544.hs:3:1-6 })) + (HsTok)) + (L + (TokenLoc + (EpaSpan { T17544.hs:3:15-19 })) + (HsTok))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:3:8-13 }) diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr index c4eee108ce..c32ecf5c96 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr @@ -43,6 +43,15 @@ " Bad comment for the module")) [])) [])))) + (HsModTk + (L + (TokenLoc + (EpaSpan { T17544_kw.hs:11:1-6 })) + (HsTok)) + (L + (TokenLoc + (EpaSpan { T17544_kw.hs:13:13-17 })) + (HsTok))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:13:3-11 }) @@ -371,5 +380,3 @@ " Bad comment for clsmethod")) [])) []))))])))])) - - diff --git a/testsuite/tests/module/mod185.stderr b/testsuite/tests/module/mod185.stderr index f5dbe2fa70..06bd7054c3 100644 --- a/testsuite/tests/module/mod185.stderr +++ b/testsuite/tests/module/mod185.stderr @@ -30,6 +30,7 @@ (1)) (Nothing) (Nothing)) + (HsNoModTk) (Nothing) (Nothing) [(L diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr index fdea6a5bce..e48bb90a6b 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr @@ -31,6 +31,15 @@ (1)) (Nothing) (Nothing)) + (HsModTk + (L + (TokenLoc + (EpaSpan { DumpParsedAst.hs:5:1-6 })) + (HsTok)) + (L + (TokenLoc + (EpaSpan { DumpParsedAst.hs:5:22-26 })) + (HsTok))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:5:8-20 }) @@ -1537,5 +1546,3 @@ {FastString: "hello"})))))))] (EmptyLocalBinds (NoExtField)))))])))))])) - - diff --git a/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr b/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr index d453ae5de1..f17c13e895 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr +++ b/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr @@ -47,6 +47,15 @@ (1)) (Nothing) (Nothing)) + (HsModTk + (L + (TokenLoc + (EpaSpan { DumpParsedAstComments.hs:5:1-6 })) + (HsTok)) + (L + (TokenLoc + (EpaSpan { DumpParsedAstComments.hs:5:30-34 })) + (HsTok))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:5:8-28 }) diff --git a/testsuite/tests/parser/should_compile/DumpSemis.stderr b/testsuite/tests/parser/should_compile/DumpSemis.stderr index 2427224e47..7fb2c67979 100644 --- a/testsuite/tests/parser/should_compile/DumpSemis.stderr +++ b/testsuite/tests/parser/should_compile/DumpSemis.stderr @@ -42,6 +42,15 @@ (1)) (Nothing) (Nothing)) + (HsModTk + (L + (TokenLoc + (EpaSpan { DumpSemis.hs:1:1-6 })) + (HsTok)) + (L + (TokenLoc + (EpaSpan { DumpSemis.hs:1:18-22 })) + (HsTok))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:1:8-16 }) @@ -2121,5 +2130,3 @@ (NoExtField)))))]))))))] (EmptyLocalBinds (NoExtField)))))])))))])) - - diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr index f9b9a986e4..a67cf529fb 100644 --- a/testsuite/tests/parser/should_compile/KindSigs.stderr +++ b/testsuite/tests/parser/should_compile/KindSigs.stderr @@ -31,6 +31,15 @@ (1)) (Nothing) (Nothing)) + (HsModTk + (L + (TokenLoc + (EpaSpan { KindSigs.hs:6:1-6 })) + (HsTok)) + (L + (TokenLoc + (EpaSpan { KindSigs.hs:6:17-21 })) + (HsTok))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { KindSigs.hs:6:8-15 }) diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr index 36768671e4..84d20a5ef3 100644 --- a/testsuite/tests/parser/should_compile/T15323.stderr +++ b/testsuite/tests/parser/should_compile/T15323.stderr @@ -31,6 +31,15 @@ (1)) (Nothing) (Nothing)) + (HsModTk + (L + (TokenLoc + (EpaSpan { T15323.hs:3:1-6 })) + (HsTok)) + (L + (TokenLoc + (EpaSpan { T15323.hs:3:15-19 })) + (HsTok))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:3:8-13 }) @@ -233,5 +242,3 @@ {OccName: v})))))) (Nothing)))]) []))))])) - - diff --git a/testsuite/tests/parser/should_compile/T20452.stderr b/testsuite/tests/parser/should_compile/T20452.stderr index 75368953b0..9231885404 100644 --- a/testsuite/tests/parser/should_compile/T20452.stderr +++ b/testsuite/tests/parser/should_compile/T20452.stderr @@ -31,6 +31,15 @@ (1)) (Nothing) (Nothing)) + (HsModTk + (L + (TokenLoc + (EpaSpan { T20452.hs:3:1-6 })) + (HsTok)) + (L + (TokenLoc + (EpaSpan { T20452.hs:3:15-19 })) + (HsTok))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T20452.hs:3:8-13 }) @@ -627,5 +636,3 @@ [] [] [])))])) - - diff --git a/testsuite/tests/parser/should_compile/T20718.stderr b/testsuite/tests/parser/should_compile/T20718.stderr index ab90eb29bc..4d880a65a3 100644 --- a/testsuite/tests/parser/should_compile/T20718.stderr +++ b/testsuite/tests/parser/should_compile/T20718.stderr @@ -62,6 +62,15 @@ (1)) (Nothing) (Nothing)) + (HsModTk + (L + (TokenLoc + (EpaSpan { T20718.hs:3:1-6 })) + (HsTok)) + (L + (TokenLoc + (EpaSpan { T20718.hs:3:15-19 })) + (HsTok))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T20718.hs:3:8-13 }) diff --git a/testsuite/tests/parser/should_compile/T20718b.stderr b/testsuite/tests/parser/should_compile/T20718b.stderr index 79b5d67bb3..7424f4738f 100644 --- a/testsuite/tests/parser/should_compile/T20718b.stderr +++ b/testsuite/tests/parser/should_compile/T20718b.stderr @@ -62,6 +62,15 @@ (1)) (Nothing) (Nothing)) + (HsModTk + (L + (TokenLoc + (EpaSpan { T20718b.hs:4:1-6 })) + (HsTok)) + (L + (TokenLoc + (EpaSpan { T20718b.hs:4:16-20 })) + (HsTok))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T20718b.hs:4:8-14 }) @@ -69,5 +78,3 @@ (Nothing) [] [])) - - diff --git a/testsuite/tests/parser/should_compile/T20846.stderr b/testsuite/tests/parser/should_compile/T20846.stderr index edacbd9ff6..c45438b3ef 100644 --- a/testsuite/tests/parser/should_compile/T20846.stderr +++ b/testsuite/tests/parser/should_compile/T20846.stderr @@ -31,6 +31,15 @@ (1)) (Nothing) (Nothing)) + (HsModTk + (L + (TokenLoc + (EpaSpan { T20846.hs:1:1-6 })) + (HsTok)) + (L + (TokenLoc + (EpaSpan { T20846.hs:1:15-19 })) + (HsTok))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T20846.hs:1:8-13 }) diff --git a/testsuite/tests/printer/T18791.stderr b/testsuite/tests/printer/T18791.stderr index 52c97faba4..435a5dee21 100644 --- a/testsuite/tests/printer/T18791.stderr +++ b/testsuite/tests/printer/T18791.stderr @@ -31,6 +31,15 @@ (1)) (Nothing) (Nothing)) + (HsModTk + (L + (TokenLoc + (EpaSpan { T18791.hs:2:1-6 })) + (HsTok)) + (L + (TokenLoc + (EpaSpan { T18791.hs:2:15-19 })) + (HsTok))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:2:8-13 }) @@ -143,5 +152,3 @@ {OccName: T})))) (Nothing)))]) []))))])) - - diff --git a/testsuite/tests/printer/Test20297.stdout b/testsuite/tests/printer/Test20297.stdout index 9a220e21db..d5d92212d4 100644 --- a/testsuite/tests/printer/Test20297.stdout +++ b/testsuite/tests/printer/Test20297.stdout @@ -38,6 +38,15 @@ (1)) (Nothing) (Nothing)) + (HsModTk + (L + (TokenLoc + (EpaSpan { Test20297.hs:2:1-6 })) + (HsTok)) + (L + (TokenLoc + (EpaSpan { Test20297.hs:2:18-22 })) + (HsTok))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:2:8-16 }) @@ -385,6 +394,15 @@ (1)) (Nothing) (Nothing)) + (HsModTk + (L + (TokenLoc + (EpaSpan { Test20297.ppr.hs:2:1-6 })) + (HsTok)) + (L + (TokenLoc + (EpaSpan { Test20297.ppr.hs:2:18-22 })) + (HsTok))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:2:8-16 }) @@ -669,4 +687,3 @@ (EmptyLocalBinds (NoExtField)))))]))))]} [])))))])))))])) - diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs index 85b70076ff..e99cec2ee9 100644 --- a/utils/check-exact/ExactPrint.hs +++ b/utils/check-exact/ExactPrint.hs @@ -1367,7 +1367,7 @@ instance ExactPrint (HsModule GhcPs) where `debug` ("setAnnotationAnchor hsmod called" ++ showAst (anc,cs)) exact hsmod@(HsModule {hsmodExt = XModulePs { hsmodAnn = EpAnnNotUsed }}) = withPpr hsmod >> return hsmod - exact (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports imports decls) = do + exact (HsModule (XModulePs an lo mdeprec mbDoc) headertoks mmn mexports imports decls) = do mbDoc' <- markAnnotated mbDoc @@ -1398,7 +1398,7 @@ instance ExactPrint (HsModule GhcPs) where let anf = an0 { anns = (anns an0) { am_decls = am_decls' }} debugM $ "HsModule, anf=" ++ showAst anf - return (HsModule (XModulePs anf lo mdeprec' mbDoc') mmn' mexports' imports' decls') + return (HsModule (XModulePs anf lo mdeprec' mbDoc') headertoks mmn' mexports' imports' decls') -- --------------------------------------------------------------------- diff --git a/utils/check-exact/Transform.hs b/utils/check-exact/Transform.hs index 13c089eb71..a4c074d5be 100644 --- a/utils/check-exact/Transform.hs +++ b/utils/check-exact/Transform.hs @@ -753,7 +753,7 @@ balanceSameLineComments (L la (Match anm mctxt pats (GRHSs x grhss lb))) = do -- --------------------------------------------------------------------- anchorEof :: ParsedSource -> ParsedSource -anchorEof (L l m@(HsModule (XModulePs an _lo _ _) _mn _exps _imps _decls)) = L l (m { hsmodExt = (hsmodExt m){ hsmodAnn = an' } }) +anchorEof (L l m@(HsModule (XModulePs an _lo _ _) _ht _mn _exps _imps _decls)) = L l (m { hsmodExt = (hsmodExt m){ hsmodAnn = an' } }) where an' = addCommentOrigDeltasAnn an @@ -893,12 +893,12 @@ class (Data t) => HasDecls t where -- --------------------------------------------------------------------- instance HasDecls ParsedSource where - hsDecls (L _ (HsModule (XModulePs _ _lo _ _) _mn _exps _imps decls)) = return decls - replaceDecls (L l (HsModule (XModulePs a lo deps haddocks) mname exps imps _decls)) decls + hsDecls (L _ (HsModule (XModulePs _ _lo _ _) _ht _mn _exps _imps decls)) = return decls + replaceDecls (L l (HsModule (XModulePs a lo deps haddocks) headertoks mname exps imps _decls)) decls = do logTr "replaceDecls LHsModule" -- modifyAnnsT (captureOrder m decls) - return (L l (HsModule (XModulePs a lo deps haddocks) mname exps imps decls)) + return (L l (HsModule (XModulePs a lo deps haddocks) headertoks mname exps imps decls)) -- --------------------------------------------------------------------- -- cgit v1.2.1