From 6ae7e1b9cdedbcad2371f7343734569842304601 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Sun, 20 Feb 2022 21:07:10 +1300 Subject: [PATCH] Fix reentrancy complaints from GHC, attempt to fix segfault. --- Data/Text/Glyphize.hs | 2 ++ Data/Text/Glyphize/Buffer.hs | 5 +++-- Data/Text/Glyphize/Font.hs | 22 ++++++++++++---------- 3 files changed, 17 insertions(+), 12 deletions(-) diff --git a/Data/Text/Glyphize.hs b/Data/Text/Glyphize.hs index c46c4ed..56efe9b 100644 --- a/Data/Text/Glyphize.hs +++ b/Data/Text/Glyphize.hs @@ -20,6 +20,8 @@ foreign import ccall "hb_shape" hb_shape :: Font_ -> Buffer_ -> Ptr Feature -> I shape :: Font -> Buffer -> [(GlyphInfo, GlyphPos)] shape font buf = shapeWithFeatures font buf [] +-- FIXME Certain input text can trigger a segfault. I'm not sure how to debug this. + data Feature = Feature { tag :: String, value :: Word32, diff --git a/Data/Text/Glyphize/Buffer.hs b/Data/Text/Glyphize/Buffer.hs index 76529a3..25c443e 100644 --- a/Data/Text/Glyphize/Buffer.hs +++ b/Data/Text/Glyphize/Buffer.hs @@ -192,6 +192,7 @@ freeze = unsafePerformIO . freeze' -- | Variant of `freeze` for use in IO code. freeze' buf = do buffer <- hb_buffer_create + assert (buffer /= nullPtr) $ pure () case text buf of Right bs -> hb_buffer_add_bytestring buffer bs -- Convert text to bytestring for now due to the text 2.0 UTF-8 transition. @@ -236,7 +237,7 @@ glyphInfos' :: Buffer' -> IO [GlyphInfo] glyphInfos' buf' = alloca $ \length' -> do arr <- withForeignPtr buf' $ \buf'' -> hb_buffer_get_glyph_infos buf'' length' length <- peek length' - if length == 0 + if length == 0 || arr == nullPtr then return [] else forM [0..fromEnum length - 1] $ peekElemOff arr -- | The Buffer's glyph position list. If not already computed defaults to all 0s. @@ -247,7 +248,7 @@ glyphsPos' :: Buffer' -> IO [GlyphPos] glyphsPos' buf' = alloca $ \length' -> do arr <- withForeignPtr buf' $ \buf'' -> hb_buffer_get_glyph_positions buf'' length' length <- peek length' - if length == 0 + if length == 0 || arr == nullPtr then return [] else forM [0..fromEnum length-1] $ peekElemOff arr diff --git a/Data/Text/Glyphize/Font.hs b/Data/Text/Glyphize/Font.hs index 45294e3..570c9e9 100644 --- a/Data/Text/Glyphize/Font.hs +++ b/Data/Text/Glyphize/Font.hs @@ -32,22 +32,23 @@ countFace bytes = unsafePerformIO $ do withForeignPtr blob hb_face_count foreign import ccall "hb_face_create" hb_face_create :: Blob_ -> Word -> IO Face_ -foreign import ccall "&hb_face_destroy" hb_face_destroy :: FunPtr (Face_ -> IO ()) +foreign import ccall "hb_face_destroy" hb_face_destroy :: Face_ -> IO () +foreign import ccall "&hb_face_destroy" hb_face_destroy' :: FunPtr (Face_ -> IO ()) createFace :: ByteString -> Word -> Face createFace bytes index = unsafePerformIO $ do blob <- bs2blob bytes face <- withForeignPtr blob $ flip hb_face_create index - newForeignPtr hb_face_destroy face + Conc.newForeignPtr face $ hb_face_destroy face foreign import ccall "hb_ft_face_create_referenced" hb_ft_face_create_referenced :: FT_Face -> Face_ ftCreateFace :: FT_Face -> Face ftCreateFace = - unsafePerformIO . newForeignPtr hb_face_destroy . hb_ft_face_create_referenced + unsafePerformIO . newForeignPtr hb_face_destroy' . hb_ft_face_create_referenced foreign import ccall "hb_face_get_empty" hb_face_get_empty :: Face_ emptyFace :: Face -emptyFace = unsafePerformIO $ newForeignPtr hb_face_destroy hb_face_get_empty +emptyFace = unsafePerformIO $ newForeignPtr hb_face_destroy' hb_face_get_empty foreign import ccall "hb_face_get_table_tags" hb_face_get_table_tags :: Face_ -> Word -> Ptr Word -> Ptr Word32 -> IO Word @@ -102,12 +103,13 @@ data Font' foreign import ccall "hb_font_create" hb_font_create :: Face_ -> IO Font_ foreign import ccall "hb_font_make_immutable" hb_font_make_immutable :: Font_ -> IO () -foreign import ccall "&hb_font_destroy" hb_font_destroy :: FunPtr (Font_ -> IO ()) +foreign import ccall "hb_font_destroy" hb_font_destroy :: Font_ -> IO () +foreign import ccall "&hb_font_destroy" hb_font_destroy' :: FunPtr (Font_ -> IO ()) createFont :: Face -> Font createFont fce = unsafePerformIO $ do font <- withForeignPtr fce $ hb_font_create hb_font_make_immutable font - newForeignPtr hb_font_destroy font + Conc.newForeignPtr font $ hb_font_destroy font foreign import ccall "hb_ft_font_create_referenced" hb_ft_font_create_referenced :: FT_Face -> IO Font_ @@ -115,11 +117,11 @@ ftCreateFont :: FT_Face -> IO Font ftCreateFont fce = do font <- hb_ft_font_create_referenced fce hb_font_make_immutable font - newForeignPtr hb_font_destroy font + newForeignPtr hb_font_destroy' font foreign import ccall "hb_font_get_empty" hb_font_get_empty :: Font_ emptyFont :: Font -emptyFont = unsafePerformIO $ newForeignPtr hb_font_destroy hb_font_get_empty +emptyFont = unsafePerformIO $ newForeignPtr hb_font_destroy' hb_font_get_empty foreign import ccall "hb_font_get_glyph" hb_font_get_glyph :: Font_ -> Word32 -> Word32 -> Ptr Word32 -> IO Bool @@ -439,14 +441,14 @@ createFontWithOptions opts fce = unsafePerformIO $ do font <- withForeignPtr fce $ hb_font_create _setFontOptions font opts hb_font_make_immutable font - newForeignPtr hb_font_destroy font + Conc.newForeignPtr font $ hb_font_destroy font ftCreateFontWithOptions :: FontOptions -> FT_Face -> Font ftCreateFontWithOptions opts fce = unsafePerformIO $ do font <- hb_ft_font_create_referenced fce _setFontOptions font opts hb_font_make_immutable font - newForeignPtr hb_font_destroy font + newForeignPtr hb_font_destroy' font foreign import ccall "hb_font_set_ppem" hb_font_set_ppem :: Font_ -> Word -> Word -> IO () foreign import ccall "hb_font_set_ptem" hb_font_set_ptem :: Font_ -> Float -> IO () -- 2.30.2