diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2019-02-03 10:27:42 +0200 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2019-02-20 14:28:55 -0500 |
commit | e0375ba980fd5639d23a29575efb00c30d97c743 (patch) | |
tree | 72500635b779f87213ecc9eacd29f32ede771648 | |
parent | a7c1f9bb17933816f7d56c9ad016a2c26ad5c8a8 (diff) | |
download | haskell-e0375ba980fd5639d23a29575efb00c30d97c743.tar.gz |
Lexer: Alternate Layout Rule injects actual not virtual braces
When the alternate layout rule is activated via a pragma, it injects
tokens for { and } to make sure that the source is parsed properly.
But it injects ITocurly and ITccurly, rather than their virtual
counterparts ITvocurly and ITvccurly.
This causes problems for ghc-exactprint, which tries to print these.
Likewise, any injected ITsemi should have a zero-width SrcSpan.
Test case (the existing T13087.hs)
{-# LANGUAGE AlternativeLayoutRule #-}
{-# LANGUAGE LambdaCase #-}
isOne :: Int -> Bool
isOne = \case 1 -> True
_ -> False
main = return ()
Closes #16279
(cherry picked from commit c1cf2693d6efddeeeb813cd8995a1be136800d17)
-rw-r--r-- | compiler/parser/Lexer.x | 32 | ||||
m--------- | libraries/Cabal | 0 | ||||
m--------- | libraries/transformers | 0 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/Makefile | 20 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/T16279.stdout | 30 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/Test16279.hs | 10 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/annotations/all.T | 2 | ||||
m--------- | utils/haddock | 0 | ||||
m--------- | utils/hsc2hs | 0 |
9 files changed, 79 insertions, 15 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index c4d0d4d127..4ba50c1d5b 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -2686,23 +2686,23 @@ alternativeLayoutRuleToken t do setAlrExpectingOCurly Nothing setALRContext (ALRLayout expectingOCurly thisCol : context) setNextToken t - return (L thisLoc ITocurly) + return (L thisLoc ITvocurly) | otherwise -> do setAlrExpectingOCurly Nothing - setPendingImplicitTokens [L lastLoc ITccurly] + setPendingImplicitTokens [L lastLoc ITvccurly] setNextToken t - return (L lastLoc ITocurly) + return (L lastLoc ITvocurly) (_, _, Just expectingOCurly) -> do setAlrExpectingOCurly Nothing setALRContext (ALRLayout expectingOCurly thisCol : context) setNextToken t - return (L thisLoc ITocurly) + return (L thisLoc ITvocurly) -- We do the [] cases earlier than in the spec, as we -- have an actual EOF token (ITeof, ALRLayout _ _ : ls, _) -> do setALRContext ls setNextToken t - return (L thisLoc ITccurly) + return (L thisLoc ITvccurly) (ITeof, _, _) -> return t -- the other ITeof case omitted; general case below covers it @@ -2713,7 +2713,7 @@ alternativeLayoutRuleToken t | newLine -> do setPendingImplicitTokens [t] setALRContext ls - return (L thisLoc ITccurly) + return (L thisLoc ITvccurly) -- This next case is to handle a transitional issue: (ITwhere, ALRLayout _ col : ls, _) | newLine && thisCol == col && transitional -> @@ -2725,7 +2725,7 @@ alternativeLayoutRuleToken t setNextToken t -- Note that we use lastLoc, as we may need to close -- more layouts, or give a semicolon - return (L lastLoc ITccurly) + return (L lastLoc ITvccurly) -- This next case is to handle a transitional issue: (ITvbar, ALRLayout _ col : ls, _) | newLine && thisCol == col && transitional -> @@ -2737,17 +2737,19 @@ alternativeLayoutRuleToken t setNextToken t -- Note that we use lastLoc, as we may need to close -- more layouts, or give a semicolon - return (L lastLoc ITccurly) + return (L lastLoc ITvccurly) (_, ALRLayout _ col : ls, _) | newLine && thisCol == col -> do setNextToken t - return (L thisLoc ITsemi) + let loc = realSrcSpanStart thisLoc + zeroWidthLoc = mkRealSrcSpan loc loc + return (L zeroWidthLoc ITsemi) | newLine && thisCol < col -> do setALRContext ls setNextToken t -- Note that we use lastLoc, as we may need to close -- more layouts, or give a semicolon - return (L lastLoc ITccurly) + return (L lastLoc ITvccurly) -- We need to handle close before open, as 'then' is both -- an open and a close (u, _, _) @@ -2756,7 +2758,7 @@ alternativeLayoutRuleToken t ALRLayout _ _ : ls -> do setALRContext ls setNextToken t - return (L thisLoc ITccurly) + return (L thisLoc ITvccurly) ALRNoLayout _ isLet : ls -> do let ls' = if isALRopen u then ALRNoLayout (containsCommas u) False : ls @@ -2779,21 +2781,21 @@ alternativeLayoutRuleToken t (ITin, ALRLayout ALRLayoutLet _ : ls, _) -> do setALRContext ls setPendingImplicitTokens [t] - return (L thisLoc ITccurly) + return (L thisLoc ITvccurly) (ITin, ALRLayout _ _ : ls, _) -> do setALRContext ls setNextToken t - return (L thisLoc ITccurly) + return (L thisLoc ITvccurly) -- the other ITin case omitted; general case below covers it (ITcomma, ALRLayout _ _ : ls, _) | topNoLayoutContainsCommas ls -> do setALRContext ls setNextToken t - return (L thisLoc ITccurly) + return (L thisLoc ITvccurly) (ITwhere, ALRLayout ALRLayoutDo _ : ls, _) -> do setALRContext ls setPendingImplicitTokens [t] - return (L thisLoc ITccurly) + return (L thisLoc ITvccurly) -- the other ITwhere case omitted; general case below covers it (_, _, _) -> return t diff --git a/libraries/Cabal b/libraries/Cabal -Subproject 98fcb3a964a4deef67920020a4a02d4d8552cc1 +Subproject 064d9e9082c825f538655db1868108c48240377 diff --git a/libraries/transformers b/libraries/transformers -Subproject 49655191d33912815a9389b764e2d89e9214093 +Subproject 80557845cdc0e72bc05cec19cf7a1bf5495e9e6 diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 98b45744ce..f293810d20 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -145,3 +145,23 @@ T13163: .PHONY: T15303 T15303: $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test15303.hs + +.PHONY: T16212 +T16212: + $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test16212.hs + +.PHONY: T16230 +T16230: + $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test16230.hs + +.PHONY: T16236 +T16236: + $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test16236.hs + +.PHONY: StarBinderAnns +StarBinderAnns: + $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" StarBinderAnns.hs + +.PHONY: T16279 +T16279: + $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test16279.hs diff --git a/testsuite/tests/ghc-api/annotations/T16279.stdout b/testsuite/tests/ghc-api/annotations/T16279.stdout new file mode 100644 index 0000000000..7dac950679 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T16279.stdout @@ -0,0 +1,30 @@ +---Unattached Annotation Problems (should be empty list)--- +[] +---Ann before enclosing span problem (should be empty list)--- +[ + +] + +---Annotations----------------------- +-- SrcSpan the annotation is attached to, AnnKeywordId, +-- list of locations the keyword item appears in +[ +((Test16279.hs:5:1-20,AnnDcolon), [Test16279.hs:5:7-8]), +((Test16279.hs:5:1-20,AnnSemi), [Test16279.hs:6:1]), +((Test16279.hs:5:10-12,AnnRarrow), [Test16279.hs:5:14-15]), +((Test16279.hs:5:10-20,AnnRarrow), [Test16279.hs:5:14-15]), +((Test16279.hs:(6,1)-(7,24),AnnEqual), [Test16279.hs:6:7]), +((Test16279.hs:(6,1)-(7,24),AnnFunId), [Test16279.hs:6:1-5]), +((Test16279.hs:(6,1)-(7,24),AnnSemi), [Test16279.hs:9:1]), +((Test16279.hs:(6,9)-(7,24),AnnCase), [Test16279.hs:6:10-13]), +((Test16279.hs:(6,9)-(7,24),AnnLam), [Test16279.hs:6:9]), +((Test16279.hs:6:15-23,AnnSemi), [Test16279.hs:7:15]), +((Test16279.hs:6:17-23,AnnRarrow), [Test16279.hs:6:17-18]), +((Test16279.hs:7:17-24,AnnRarrow), [Test16279.hs:7:17-18]), +((Test16279.hs:9:1-16,AnnEqual), [Test16279.hs:9:6]), +((Test16279.hs:9:1-16,AnnFunId), [Test16279.hs:9:1-4]), +((Test16279.hs:9:1-16,AnnSemi), [Test16279.hs:11:1]), +((Test16279.hs:9:15-16,AnnCloseP), [Test16279.hs:9:16]), +((Test16279.hs:9:15-16,AnnOpenP), [Test16279.hs:9:15]), +((<no location info>,AnnEofPos), [Test16279.hs:11:1]) +]
\ No newline at end of file diff --git a/testsuite/tests/ghc-api/annotations/Test16279.hs b/testsuite/tests/ghc-api/annotations/Test16279.hs new file mode 100644 index 0000000000..7817edadc5 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test16279.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE AlternativeLayoutRule #-} +{-# LANGUAGE LambdaCase #-} +-- duplicate of T13087.hs + +isOne :: Int -> Bool +isOne = \case 1 -> True + _ -> False + +main = return () + diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index 666cb3f044..b4b21e262c 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -59,3 +59,5 @@ test('T13163', [extra_files(['Test13163.hs']), ignore_stderr], run_command, ['$MAKE -s --no-print-directory T13163']) test('T15303', [extra_files(['Test15303.hs']), ignore_stderr], run_command, ['$MAKE -s --no-print-directory T15303']) +test('T16279', [extra_files(['Test16279.hs']), + ignore_stderr], makefile_test, ['T16279']) diff --git a/utils/haddock b/utils/haddock -Subproject 21e4f3fa6f73a9b25f3deed80da0e56024238ea +Subproject 6414b46e1ac8b63cad20d662311788a80e3b29b diff --git a/utils/hsc2hs b/utils/hsc2hs -Subproject fac8b62e48f4c99cfe8f3efff63c8fcd94b2a1d +Subproject a816333ae67c54b98cce4ed22621242714967b3 |