diff options
| -rw-r--r-- | compiler/GHC/Parser.y | 2 | ||||
| -rw-r--r-- | compiler/GHC/Parser/Annotation.hs | 8 | ||||
| -rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 7 | ||||
| -rw-r--r-- | testsuite/tests/printer/Makefile | 6 | ||||
| -rw-r--r-- | testsuite/tests/printer/Test20247.hs | 4 | ||||
| -rw-r--r-- | testsuite/tests/printer/all.T | 1 |
6 files changed, 25 insertions, 3 deletions
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index a11a438d89..90b17018ff 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -1791,7 +1791,7 @@ binds :: { Located (HsLocalBinds GhcPs) } -- No type declarations : decllist {% do { val_binds <- cvBindGroup (unLoc $ snd $ unLoc $1) ; cs <- getCommentsFor (gl $1) - ; return (sL1 $1 $ HsValBinds (EpAnn (glR $1) (fst $ unLoc $1) cs) val_binds)} } + ; return (sL1 $1 $ HsValBinds (fixValbindsAnn $ EpAnn (glR $1) (fst $ unLoc $1) cs) val_binds)} } | '{' dbinds '}' {% acs (\cs -> (L (comb3 $1 $2 $3) $ HsIPBinds (EpAnn (glR $1) (AnnList (Just$ glR $2) (Just $ moc $1) (Just $ mcc $3) [] []) cs) (IPBinds noExtField (reverse $ unLoc $2)))) } diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs index 1f48615aec..4f7525842f 100644 --- a/compiler/GHC/Parser/Annotation.hs +++ b/compiler/GHC/Parser/Annotation.hs @@ -43,7 +43,8 @@ module GHC.Parser.Annotation ( AnnSortKey(..), -- ** Trailing annotations in lists - TrailingAnn(..), addTrailingAnnToA, addTrailingAnnToL, addTrailingCommaToN, + TrailingAnn(..), trailingAnnToAddEpAnn, + addTrailingAnnToA, addTrailingAnnToL, addTrailingCommaToN, -- ** Utilities for converting between different 'GenLocated' when -- ** we do not care about the annotations. @@ -806,6 +807,11 @@ data AnnSortKey -- --------------------------------------------------------------------- +-- | Convert a 'TrailingAnn' to an 'AddEpAnn' +trailingAnnToAddEpAnn :: TrailingAnn -> AddEpAnn +trailingAnnToAddEpAnn (AddSemiAnn ss) = AddEpAnn AnnSemi ss +trailingAnnToAddEpAnn (AddCommaAnn ss) = AddEpAnn AnnComma ss +trailingAnnToAddEpAnn (AddVbarAnn ss) = AddEpAnn AnnVbar ss -- | Helper function used in the parser to add a 'TrailingAnn' items -- to an existing annotation. diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index b9be24259a..f5c7a513c7 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -37,6 +37,7 @@ module GHC.Parser.PostProcess ( setRdrNameSpace, fromSpecTyVarBndr, fromSpecTyVarBndrs, annBinds, + fixValbindsAnn, cvBindGroup, cvBindsAndSigs, @@ -471,6 +472,11 @@ patch_anchor r1 (Anchor r0 op) = Anchor r op where r = if srcSpanStartLine r0 < 0 then r1 else r0 +fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList +fixValbindsAnn EpAnnNotUsed = EpAnnNotUsed +fixValbindsAnn (EpAnn anchor (AnnList ma o c r t) cs) + = (EpAnn (widenAnchor anchor (map trailingAnnToAddEpAnn t)) (AnnList ma o c r t) cs) + {- ********************************************************************** #cvBinds-etc# Converting to @HsBinds@, etc. @@ -1002,7 +1008,6 @@ checkTyClHdr is_cls ty newAnns (SrcSpanAnn EpAnnNotUsed l) (EpAnn as (AnnParen _ o c) cs) = let lr = combineRealSrcSpans (realSrcSpan l) (anchor as) - -- lr = widenAnchorR as (realSrcSpan l) an = (EpAnn (Anchor lr UnchangedAnchor) (NameAnn NameParens o (EpaSpan $ realSrcSpan l) c []) cs) in SrcSpanAnn an (RealSrcSpan lr Strict.Nothing) newAnns _ EpAnnNotUsed = panic "missing AnnParen" diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile index 749315c60a..2c4195eeb1 100644 --- a/testsuite/tests/printer/Makefile +++ b/testsuite/tests/printer/Makefile @@ -734,6 +734,12 @@ Test20243: $(CHECK_PPR) $(LIBDIR) Test20243.hs $(CHECK_EXACT) $(LIBDIR) Test20243.hs +.PHONY: Test20247 +Test20247: + $(CHECK_PPR) $(LIBDIR) Test20247.hs + $(CHECK_EXACT) $(LIBDIR) Test20247.hs + + .PHONY: Test20258 Test20258: $(CHECK_PPR) $(LIBDIR) Test20258.hs diff --git a/testsuite/tests/printer/Test20247.hs b/testsuite/tests/printer/Test20247.hs new file mode 100644 index 0000000000..8c2521fe9a --- /dev/null +++ b/testsuite/tests/printer/Test20247.hs @@ -0,0 +1,4 @@ +module Test20247 where + +foo = do + let ;x =1 diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T index 3d7c28e453..4562acc8e5 100644 --- a/testsuite/tests/printer/all.T +++ b/testsuite/tests/printer/all.T @@ -173,6 +173,7 @@ test('PprUnicodeSyntax', [ignore_stderr, req_ppr_deps], makefile_test, ['PprUnic test('PprCommentPlacement2', [ignore_stderr, req_ppr_deps], makefile_test, ['PprCommentPlacement2']) test('Test20243', [ignore_stderr, req_ppr_deps], makefile_test, ['Test20243']) +test('Test20247', [ignore_stderr, req_ppr_deps], makefile_test, ['Test20247']) test('Test20258', [ignore_stderr, req_ppr_deps], makefile_test, ['Test20258']) test('Test20297', [ignore_stderr, req_ppr_deps], makefile_test, ['Test20297']) test('Test20846', [ignore_stderr, req_ppr_deps], makefile_test, ['Test20846']) |