From: simonmar <unknown>
Date: Fri, 14 Apr 2000 16:17:47 +0000 (+0000)
Subject: [project @ 2000-04-14 16:17:47 by simonmar]
X-Git-Tag: Approximately_9120_patches~4686
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=bc7b4b64c0c55c99c6c7bb8b9290aa9e916edda7;p=ghc-hetmet.git

[project @ 2000-04-14 16:17:47 by simonmar]
catch exceptions around commitBuffer and free the buffer.  This closes
one memory leak in the new I/O stuff, there may be another small one left.
---

diff --git a/ghc/lib/std/PrelIO.lhs b/ghc/lib/std/PrelIO.lhs
index 43e0c63..c0a957f 100644
--- a/ghc/lib/std/PrelIO.lhs
+++ b/ghc/lib/std/PrelIO.lhs
@@ -500,6 +500,13 @@ write_buf fo buf count = do
 	then  write_buf fo buf (count - rc) -- partial write
 	else  return rc
 
+-- a version of commitBuffer that will free the buffer if an exception is received.
+-- DON'T use this if you intend to use the buffer again!
+checkedCommitBuffer handle buf sz count flush 
+  = catchException (commitBuffer handle buf sz count flush) 
+		   (\e -> do withHandle__ handle (\h_ -> freeBuffer h_ buf sz)
+			     throw e)
+
 foreign import "memcpy" unsafe memcpy :: Addr -> Addr -> Int -> IO ()
 \end{code}
 
@@ -529,7 +536,7 @@ writeLines handle buf bufLen s =
 	let next_n = n + 1
 	if next_n == bufLen || x == '\n'
 	 then do
-	   commitBuffer hdl buf len next_n True{-needs flush-} 
+	   checkedCommitBuffer hdl buf len next_n True{-needs flush-} 
 	   shoveString 0 xs
          else
 	   shoveString next_n xs
@@ -553,7 +560,7 @@ writeLines hdl buf len@(I# bufLen) s =
 	let next_n = n +# 1#
 	if next_n ==# bufLen || x `eqChar#` '\n'#
 	 then do
-	   commitBuffer hdl buf len (I# next_n) True{-needs flush-} 
+	   checkedCommitBuffer hdl buf len (I# next_n) True{-needs flush-} 
 	   shoveString 0# xs
          else
 	   shoveString next_n xs
@@ -575,7 +582,7 @@ writeBlocks hdl buf bufLen s =
 	let next_n = n + 1
 	if next_n == bufLen
 	 then do
-	   commitBuffer hdl buf len next_n True{-needs flush-}
+	   checkedCommitBuffer hdl buf len next_n True{-needs flush-}
 	   shoveString 0 xs
          else
 	   shoveString next_n xs
@@ -597,7 +604,7 @@ writeBlocks hdl buf len@(I# bufLen) s =
 	let next_n = n +# 1#
 	if next_n ==# bufLen
 	 then do
-	   commitBuffer hdl buf len (I# next_n) True{-needs flush-}
+	   checkedCommitBuffer hdl buf len (I# next_n) True{-needs flush-}
 	   shoveString 0# xs
          else
 	   shoveString next_n xs