Merge pull request haskell#142 from haskell/issue-127

Issue 127

ChangeLog.md

@@ -2,6 +2,7 @@
 
 - Add `INLINABLE` pragmas to most overloaded combinators
 - Support recent versions of dependencies
+- Fix memory leak in `>>=` https://github.com/haskell/parsec/issues/127
 
 ### 3.1.14.0
 

parsec.cabal

@@ -128,3 +128,10 @@ test-suite parsec.
         ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances
     else
         build-depends: semigroups
+
+test-suite parsec-issue127
+    default-language: Haskell2010
+    type: exitcode-stdio-1.0
+    main-is: issue127.hs
+    hs-source-dirs: test
+    build-depends: base, parsec

src/Text/Parsec/Prim.hs

@@ -318,7 +318,9 @@ parserBind m k
   = ParsecT $ \s cok cerr eok eerr ->
     let
         -- consumed-okay case for m
-        mcok x s err =
+        mcok x s err
+          | errorIsUnknown err = unParser (k x) s cok cerr cok cerr
+          | otherwise =
             let
                  -- if (k x) consumes, those go straigt up
                  pcok = cok
@@ -335,7 +337,9 @@ parserBind m k
             in  unParser (k x) s pcok pcerr peok peerr
 
         -- empty-ok case for m
-        meok x s err =
+        meok x s err
+          | errorIsUnknown err = unParser (k x) s cok cerr eok eerr
+          | otherwise =
             let
                 -- in these cases, (k x) can return as empty
                 pcok = cok

test/issue127.hs

@@ -0,0 +1,13 @@
+module Main (main) where
+
+import Text.Parsec
+import System.Environment (getArgs)
+import Control.Monad (replicateM_)
+
+main :: IO ()
+main = do
+  n <- getArgs >>= \args -> return $ case args of
+      arg : _ -> read arg
+      _       -> 1000000
+
+  print $ runParser (replicateM_ n $ return ()) () "test" ""