parsec 3.1.6 → 3.1.7

raw patch · 10 files changed

+166/−66 lines, 10 files

Files

• CHANGES +6/−0
• Text/Parsec/Prim.hs +22/−33
• parsec.cabal +7/−2
• test/Bugs.hs +16/−0
• test/Bugs/Bug2.hs +28/−0
• test/Bugs/Bug6.hs +25/−0
• test/Bugs/Bug9.hs +46/−0
• test/Main.hs +2/−2
• test/Tokens.hs +0/−29
• test/Util.hs +14/−0

@@ -1,3 +1,9 @@+3.1.7++- Fix a regression from 3.1.6 related to the reported position of error messages.+  See bug #9 for details.+- Reset the current error position on success of 'lookAhead'.+ 3.1.6  - Export 'Text' instances from Text.Parsec

@@ -13,7 +13,7 @@ -----------------------------------------------------------------------------     {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts,-             UndecidableInstances, ScopedTypeVariables #-}+             UndecidableInstances #-} {-# OPTIONS_HADDOCK not-home #-}  module Text.Parsec.Prim@@ -393,8 +393,7 @@     {-# INLINE uncons #-}  -tokens :: forall u s m t .-          (Stream s m t, Eq t)+tokens :: (Stream s m t, Eq t)        => ([t] -> String)      -- Pretty print a list of tokens        -> (SourcePos -> [t] -> SourcePos)        -> [t]                  -- List of tokens to parse@@ -404,38 +403,32 @@     = ParsecT $ \s _ _ eok _ ->       eok [] s $ unknownError s tokens showTokens nextposs tts@(tok:toks)-    = ParsecT $ \(State input pos0 u) cok cerr eok eerr -> +    = ParsecT $ \(State input pos u) cok cerr eok eerr ->      let-        nextpos :: SourcePos -> t -> SourcePos-        nextpos pos t = nextposs pos [t]--        errEof pos ts =-            (setErrorMessage (Expect (showTokens ts))-             (newErrorMessage (SysUnExpect "") pos))+        errEof = (setErrorMessage (Expect (showTokens tts))+                  (newErrorMessage (SysUnExpect "") pos)) -        errExpect pos ts x =-            (setErrorMessage (Expect (showTokens ts))-             (newErrorMessage (SysUnExpect (showTokens [x])) pos))+        errExpect x = (setErrorMessage (Expect (showTokens tts))+                       (newErrorMessage (SysUnExpect (showTokens [x])) pos)) -        -- 'pos' is the position of the first token in the stream-        walk []     pos rs = ok pos rs-        walk allTs@(t:ts) pos rs = do+        walk []     rs = ok rs+        walk (t:ts) rs = do           sr <- uncons rs           case sr of-            Nothing                 -> cerr $ errEof pos allTs-            Just (x,xs) | t == x    -> walk ts (nextpos pos x) xs-                        | otherwise -> cerr $ errExpect pos allTs x+            Nothing                 -> cerr $ errEof+            Just (x,xs) | t == x    -> walk ts xs+                        | otherwise -> cerr $ errExpect x -        ok pos rs =-            let s' = State rs pos u-            in cok tts s' (newErrorUnknown pos)+        ok rs = let pos' = nextposs pos tts+                    s' = State rs pos' u+                in cok tts s' (newErrorUnknown pos')     in do         sr <- uncons input         case sr of-            Nothing         -> eerr $ errEof pos0 tts+            Nothing         -> eerr $ errEof             Just (x,xs)-                | tok == x  -> walk toks (nextpos pos0 x) xs-                | otherwise -> eerr $ errExpect pos0 tts x+                | tok == x  -> walk toks xs+                | otherwise -> eerr $ errExpect x          -- | The parser @try p@ behaves like parser @p@, except that it -- pretends that it hasn't consumed any input when an error occurs.@@ -479,14 +472,10 @@ -- if this is undesirable.  lookAhead :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m a-lookAhead p         = do{ state <- getParserState-                        ; x <- p'-                        ; setParserState state-                        ; return x-                        }-    where-    p' = ParsecT $ \s cok cerr eok eerr ->-         unParser p s eok cerr eok eerr+lookAhead p =+    ParsecT $ \s _ cerr eok eerr -> do+        let eok' a _ _ = eok a s (newErrorUnknown (statePos s))+        unParser p s eok' cerr eok' eerr  -- | The parser @token showTok posFromTok testTok@ accepts a token @t@ -- with result @x@ when the function @testTok t@ returns @'Just' x@. The

@@ -1,5 +1,5 @@ name:		parsec-version:	3.1.6+version:	3.1.7 cabal-version: >= 1.8 license:	BSD3 license-file:	LICENSE@@ -69,10 +69,15 @@     hs-source-dirs:  test     main-is:     Main.hs     other-modules:-                 Tokens+                 Bugs,+                 Bugs.Bug2,+                 Bugs.Bug6,+                 Bugs.Bug9,+                 Util     build-depends:        base,        parsec,        HUnit == 1.2.*,        test-framework >= 0.6 && < 0.9,        test-framework-hunit >= 0.2 && < 0.4+    ghc-options: -Wall

@@ -0,0 +1,16 @@++module Bugs+       ( bugs+       ) where++import Test.Framework++import qualified Bugs.Bug2+import qualified Bugs.Bug6+import qualified Bugs.Bug9++bugs :: [Test]+bugs = [ Bugs.Bug2.main+       , Bugs.Bug6.main+       , Bugs.Bug9.main+       ]

@@ -0,0 +1,28 @@++module Bugs.Bug2+       ( main+       ) where++import Test.HUnit hiding ( Test )+import Test.Framework+import Test.Framework.Providers.HUnit++import Text.Parsec+import Text.Parsec.String+import qualified Text.Parsec.Token as P+import Text.Parsec.Language (haskellDef)++main :: Test+main =+  testCase "Control Char Parsing (#2)" $+  parseString "\"test\\^Bstring\"" @?= "test\^Bstring"++ where+   parseString :: String -> String+   parseString input =+      case parse parser "Example" input of+        Left{} -> error "Parse failure"+        Right str -> str++   parser :: Parser String+   parser = P.stringLiteral $ P.makeTokenParser haskellDef

@@ -0,0 +1,25 @@++module Bugs.Bug6+       ( main+       ) where++import Test.HUnit hiding ( Test )+import Test.Framework+import Test.Framework.Providers.HUnit++import Text.Parsec+import Text.Parsec.String++import Util++main :: Test+main =+  testCase "Look-ahead preserving error location (#6)" $+  parseErrors variable "return" @?= ["'return' is a reserved keyword"]++variable :: Parser String+variable = do+      x <- lookAhead (many1 letter)+      if x == "return"+       then fail "'return' is a reserved keyword"+       else string x

@@ -0,0 +1,46 @@++module Bugs.Bug9 ( main ) where++import Control.Applicative ((<*), (<$>), (<$))+import Text.Parsec+import Text.Parsec.Language (haskellStyle)+import Text.Parsec.String (Parser)+import Text.Parsec.Expr+import qualified Text.Parsec.Token as P++import Test.HUnit hiding ( Test )+import Test.Framework+import Test.Framework.Providers.HUnit++import Util++data Expr = Const Integer | Op Expr Expr+  deriving Show++main :: Test+main =+  testCase "Tracing of current position in error message (#9)"+  $ result @?= ["unexpected '>'","expecting operator or end of input"]++  where+    result :: [String]+    result = parseErrors parseTopLevel "4 >> 5"++-- Syntax analaysis++parseTopLevel :: Parser Expr+parseTopLevel = parseExpr <* eof++parseExpr :: Parser Expr+parseExpr = buildExpressionParser table (Const <$> integer)+  where+        table = [[ Infix (Op <$ reserved ">>>") AssocLeft ]]++        -- Lexical analysis++        lexer = P.makeTokenParser haskellStyle { P.reservedOpNames = [">>>"] }++        integer    = P.integer    lexer+        reserved   = P.reserved   lexer+        reservedOp = P.reservedOp lexer+

@@ -1,10 +1,10 @@  import Test.Framework -import Tokens ( tokensTests )+import Bugs ( bugs )  main :: IO () main = do   defaultMain-    [ testGroup "Text.Parsec.Tokens" tokensTests+    [ testGroup "Bugs" bugs     ]

@@ -1,29 +0,0 @@--module Tokens-       ( tokensTests-       ) where--import Test.HUnit hiding ( Test )-import Test.Framework-import Test.Framework.Providers.HUnit--import Text.Parsec-import Text.Parsec.String-import qualified Text.Parsec.Token as P-import Text.Parsec.Language (haskellDef)--tokensTests :: [Test]-tokensTests =-  return $-  testCase "Control Char Parsing" $-  parseString "\"test\\^Bstring\"" @?= "test\^Bstring"-- where-   parseString :: String -> String-   parseString input =-      case parse parser "Example" input of-        Left{} -> error "Parse failure"-        Right str -> str--   parser :: Parser String-   parser = P.stringLiteral $ P.makeTokenParser haskellDef

@@ -0,0 +1,14 @@++module Util where++import Text.Parsec+import Text.Parsec.String ( Parser )++-- | Returns the error messages associated+-- with a failed parse.+parseErrors :: Parser a -> String -> [String]+parseErrors p input =+  case parse p "" input of+    Left err ->+      drop 1 $ lines $ show err+    Right{} -> []