GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-21 00:52:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

fix the memory leak in case of exceptions

Browse Source
This commit is contained in:
krangelov
2021-08-05 17:58:04 +02:00
parent 7d85d3ca9a
commit cc4a215f83
1 changed files with 4 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
src/runtime/haskell/PGF2.hsc
View File

@@ -17,7 +17,7 @@ module PGF2 (-- * PGF
PGF,readPGF PGF,readPGF
) where ) where
import Control.Exception(Exception,throwIO) import Control.Exception(Exception,throwIO,mask_)
import PGF2.FFI import PGF2.FFI
import Foreign import Foreign
@@ -30,7 +30,8 @@ import qualified Data.Map as Map
readPGF :: FilePath -> IO PGF readPGF :: FilePath -> IO PGF
readPGF fpath = readPGF fpath =
withCString fpath $ \c_fpath -> withCString fpath $ \c_fpath ->
allocaBytes (#size PgfExn) $ \c_exn -> do allocaBytes (#size PgfExn) $ \c_exn ->
mask_ $ do
c_pgf <- pgf_read c_fpath c_exn c_pgf <- pgf_read c_fpath c_exn
ex_type <- (#peek PgfExn, type) c_exn :: IO (#type PgfExnType) ex_type <- (#peek PgfExn, type) c_exn :: IO (#type PgfExnType)
if ex_type == (#const PGF_EXN_NONE) if ex_type == (#const PGF_EXN_NONE)
@@ -41,6 +42,7 @@ readPGF fpath =
ioError (errnoToIOError "readPGF" (Errno errno) Nothing (Just fpath)) ioError (errnoToIOError "readPGF" (Errno errno) Nothing (Just fpath))
else do c_msg <- (#peek PgfExn, msg) c_exn else do c_msg <- (#peek PgfExn, msg) c_exn
msg <- peekCString c_msg msg <- peekCString c_msg
free c_msg
throwIO (PGFError msg) throwIO (PGFError msg)
----------------------------------------------------------------------- -----------------------------------------------------------------------