From 68e30d98adf12b122968de5b2acd29e1d63f7c2e Mon Sep 17 00:00:00 2001 From: romes Date: Mon, 12 Dec 2022 15:20:39 +0000 Subject: [PATCH] Fix off-by-one bug in string null termination (#166) Backport withCString fix and use text version when available --- src/DearImGui/Internal/Text.hs | 35 +++++++++++++++++++--------------- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/src/DearImGui/Internal/Text.hs b/src/DearImGui/Internal/Text.hs index bd917b4..543cedb 100644 --- a/src/DearImGui/Internal/Text.hs +++ b/src/DearImGui/Internal/Text.hs @@ -26,28 +26,33 @@ import Data.Text.Foreign (withCStringLen) -- unliftio-core import UnliftIO (MonadUnliftIO, UnliftIO(..), withUnliftIO) -#if MIN_VERSION_text(2,0,0) +#if MIN_VERSION_text(2,0,1) +-- XXX: just wrap the provided combinator + +import qualified Data.Text.Foreign as Text + +withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a +withCString text action = + withUnliftIO $ \(UnliftIO unlift) -> + Text.withCString text (unlift action) + +#elif MIN_VERSION_text(2,0,0) +-- XXX: the text is UTF-8, alas no withCString is available import Data.Text.Foreign (lengthWord8, unsafeCopyToPtr) import Data.Word (Word8) -import Foreign (castPtr, free, mallocBytes, pokeByteOff) -import UnliftIO.Exception (bracket) +import Foreign (allocaBytes, castPtr, pokeByteOff) withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a -withCString t = bracket create destroy - where - size0 = lengthWord8 t + 1 - - create = liftIO $ do - ptr <- mallocBytes size0 - unsafeCopyToPtr t (castPtr ptr) - pokeByteOff ptr size0 (0 :: Word8) - pure ptr - - destroy ptr = - liftIO $ free ptr +withCString t@(Text _arr _off len) action = + withUnliftIO $ \(UnliftIO unlift) -> + allocaBytes (len + 1) $ \buf -> do + unsafeCopyToPtr t buf + pokeByteOff buf len (0 :: Word8) + unlift $ action (castPtr buf) #else +-- XXX: the text is UTF-16, let GHC do it withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a withCString t action = do