From bc7b4b64c0c55c99c6c7bb8b9290aa9e916edda7 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Fri, 14 Apr 2000 16:17:47 +0000
Subject: [PATCH] [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.
---
ghc/lib/std/PrelIO.lhs | 15 +++++++++++----
1 file changed, 11 insertions(+), 4 deletions(-)
diff --git a/ghc/lib/std/PrelIO.lhs b/ghc/lib/std/PrelIO.lhs
index 43e0c631bfa5..c0a957f4626b 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
--
GitLab