[commit: ghc] wip/heapprof001-fragile: Lexer: turn some fatal errors into non-fatal ones (f37efb1)
git at git.haskell.org
git at git.haskell.org
Sat Mar 2 14:51:55 UTC 2019
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/heapprof001-fragile
Link : http://ghc.haskell.org/trac/ghc/changeset/f37efb11b957a21f3048f7005a234f96350ff938/ghc
>---------------------------------------------------------------
commit f37efb11b957a21f3048f7005a234f96350ff938
Author: Alec Theriault <alec.theriault at gmail.com>
Date: Mon Feb 25 16:39:27 2019 -0800
Lexer: turn some fatal errors into non-fatal ones
The following previously fatal lexer errors are now non-fatal:
* errors about enabling `LambdaCase`
* errors about enabling `NumericUnderscores`
* errors about having valid characters in primitive strings
See #16270
>---------------------------------------------------------------
f37efb11b957a21f3048f7005a234f96350ff938
compiler/parser/Lexer.x | 42 ++++++++++++----------
.../parser/should_fail/ParserNoLambdaCase.stderr | 2 +-
testsuite/tests/parser/should_fail/T16270.hs | 9 ++++-
testsuite/tests/parser/should_fail/T16270.stderr | 10 +++++-
4 files changed, 42 insertions(+), 21 deletions(-)
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 5fb48eb..d77564e 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -1312,9 +1312,11 @@ varid span buf len =
keyword <- case lastTk of
Just ITlam -> do
lambdaCase <- getBit LambdaCaseBit
- if lambdaCase
- then return ITlcase
- else failMsgP "Illegal lambda-case (use -XLambdaCase)"
+ unless lambdaCase $ do
+ pState <- getPState
+ addError (RealSrcSpan (last_loc pState)) $ text
+ "Illegal lambda-case (use LambdaCase)"
+ return ITlcase
_ -> return ITcase
maybe_layout keyword
return $ L span keyword
@@ -1379,9 +1381,11 @@ tok_integral :: (SourceText -> Integer -> Token)
tok_integral itint transint transbuf translen (radix,char_to_int) span buf len = do
numericUnderscores <- getBit NumericUnderscoresBit -- #14473
let src = lexemeToString buf len
- if (not numericUnderscores) && ('_' `elem` src)
- then failMsgP "Use NumericUnderscores to allow underscores in integer literals"
- else return $ L span $ itint (SourceText src)
+ when ((not numericUnderscores) && ('_' `elem` src)) $ do
+ pState <- getPState
+ addError (RealSrcSpan (last_loc pState)) $ text
+ "Use NumericUnderscores to allow underscores in integer literals"
+ return $ L span $ itint (SourceText src)
$! transint $ parseUnsignedInteger
(offsetBytes transbuf buf) (subtract translen len) radix char_to_int
@@ -1419,9 +1423,11 @@ tok_frac :: Int -> (String -> Token) -> Action
tok_frac drop f span buf len = do
numericUnderscores <- getBit NumericUnderscoresBit -- #14473
let src = lexemeToString buf (len-drop)
- if (not numericUnderscores) && ('_' `elem` src)
- then failMsgP "Use NumericUnderscores to allow underscores in floating literals"
- else return (L span $! (f $! src))
+ when ((not numericUnderscores) && ('_' `elem` src)) $ do
+ pState <- getPState
+ addError (RealSrcSpan (last_loc pState)) $ text
+ "Use NumericUnderscores to allow underscores in floating literals"
+ return (L span $! (f $! src))
tok_float, tok_primfloat, tok_primdouble :: String -> Token
tok_float str = ITrational $! readFractionalLit str
@@ -1618,23 +1624,23 @@ lex_string s = do
Just ('"',i) -> do
setInput i
+ let s' = reverse s
magicHash <- getBit MagicHashBit
if magicHash
then do
i <- getInput
case alexGetChar' i of
Just ('#',i) -> do
- setInput i
- if any (> '\xFF') s
- then failMsgP "primitive string literal must contain only characters <= \'\\xFF\'"
- else let bs = unsafeMkByteString (reverse s)
- in return (ITprimstring (SourceText (reverse s)) bs)
+ setInput i
+ when (any (> '\xFF') s') $ do
+ pState <- getPState
+ addError (RealSrcSpan (last_loc pState)) $ text
+ "primitive string literal must contain only characters <= \'\\xFF\'"
+ return (ITprimstring (SourceText s') (unsafeMkByteString s'))
_other ->
- return (ITstring (SourceText (reverse s))
- (mkFastString (reverse s)))
+ return (ITstring (SourceText s') (mkFastString s'))
else
- return (ITstring (SourceText (reverse s))
- (mkFastString (reverse s)))
+ return (ITstring (SourceText s') (mkFastString s'))
Just ('\\',i)
| Just ('&',i) <- next -> do
diff --git a/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr b/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr
index 24d5cfc..601262c 100644
--- a/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr
+++ b/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr
@@ -1,2 +1,2 @@
ParserNoLambdaCase.hs:3:6:
- Illegal lambda-case (use -XLambdaCase)
+ Illegal lambda-case (use LambdaCase)
diff --git a/testsuite/tests/parser/should_fail/T16270.hs b/testsuite/tests/parser/should_fail/T16270.hs
index 0c5166d..0147f97 100644
--- a/testsuite/tests/parser/should_fail/T16270.hs
+++ b/testsuite/tests/parser/should_fail/T16270.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE NoTraditionalRecordSyntax, NoDoAndIfThenElse, NoMultiWayIf #-}
+{-# LANGUAGE NoTraditionalRecordSyntax, NoDoAndIfThenElse, NoMultiWayIf, NoLambdaCase, NoNumericUnderscores, MagicHash #-}
{-# OPTIONS -Werror=missing-space-after-bang #-}
module T16270 where
@@ -29,6 +29,13 @@ multiWayIf !i = (a, b)
b = if | i -> False
| otherwise -> True
+w = \case _ : _ -> True
+ _ -> False
+
+n = 123_456
+
+s = "hello ωorld"# -- note the omega
+
-- a fatal error.
k = let
diff --git a/testsuite/tests/parser/should_fail/T16270.stderr b/testsuite/tests/parser/should_fail/T16270.stderr
index 7eccd95..f4e90e4 100644
--- a/testsuite/tests/parser/should_fail/T16270.stderr
+++ b/testsuite/tests/parser/should_fail/T16270.stderr
@@ -57,5 +57,13 @@ T16270.hs:27:9: error:
T16270.hs:29:9: error:
Multi-way if-expressions need MultiWayIf turned on
-T16270.hs:36:1: error:
+T16270.hs:32:6: Illegal lambda-case (use LambdaCase)
+
+T16270.hs:35:5:
+ Use NumericUnderscores to allow underscores in integer literals
+
+T16270.hs:37:5:
+ primitive string literal must contain only characters <= '/xFF'
+
+T16270.hs:43:1: error:
parse error (possibly incorrect indentation or mismatched brackets)
More information about the ghc-commits
mailing list