From 5cd811b35c2efba244620af2db4de77283fbca78 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <alcinnz@lavabit.com>
Date: Sun, 20 Feb 2022 21:24:48 +1300
Subject: [PATCH] Fix segfault upon too much HarfBuzz concurrency.

---
 Data/Text/Glyphize.hs        | 7 +++++++
 Data/Text/Glyphize/Buffer.hs | 1 -
 2 files changed, 7 insertions(+), 1 deletion(-)

diff --git a/Data/Text/Glyphize.hs b/Data/Text/Glyphize.hs
index 56efe9b..ab09b13 100644
--- a/Data/Text/Glyphize.hs
+++ b/Data/Text/Glyphize.hs
@@ -11,6 +11,7 @@ import Foreign.Marshal.Alloc
 import Foreign.Storable
 import Foreign.C.String
 import Control.Monad (forM)
+import Control.Concurrent.QSem
 import System.IO.Unsafe (unsafePerformIO)
 
 foreign import ccall "hb_shape" hb_shape :: Font_ -> Buffer_ -> Ptr Feature -> Int -> IO ()
@@ -53,6 +54,7 @@ instance Storable Feature where
 -- higher index takes precedance.
 shapeWithFeatures :: Font -> Buffer -> [Feature] -> [(GlyphInfo, GlyphPos)]
 shapeWithFeatures font buf feats = unsafePerformIO $ do
+    waitQSem shapingSem
     buf_ <- freeze' buf
     allocaBytes (sizeOf (undefined :: Feature) * length feats) $ \arr' -> do
         forM (zip [0..] feats) $ \(i, feat) -> pokeElemOff arr' i feat
@@ -60,8 +62,13 @@ shapeWithFeatures font buf feats = unsafePerformIO $ do
             hb_shape font' buf' arr' $ length feats
     infos <- glyphInfos' buf_
     pos <- glyphsPos' buf_
+    signalQSem shapingSem
     return $ zip infos pos
 
+-- | Used to avoid segfaults...
+{-# NOINLINE shapingSem #-}
+shapingSem = unsafePerformIO $ newQSem 25
+
 foreign import ccall "hb_version" hb_version :: Ptr Int -> Ptr Int -> Ptr Int -> IO ()
 version :: (Int, Int, Int)
 version = unsafePerformIO $
diff --git a/Data/Text/Glyphize/Buffer.hs b/Data/Text/Glyphize/Buffer.hs
index 25c443e..69a3da6 100644
--- a/Data/Text/Glyphize/Buffer.hs
+++ b/Data/Text/Glyphize/Buffer.hs
@@ -192,7 +192,6 @@ 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.
-- 
2.30.2