mirror of
				https://github.com/Drezil/dear-imgui.hs.git
				synced 2025-11-04 07:01:06 +01:00 
			
		
		
		
	Fix off-by-one bug in string null termination (#166)
Backport withCString fix and use text version when available
This commit is contained in:
		@@ -26,28 +26,33 @@ import Data.Text.Foreign (withCStringLen)
 | 
				
			|||||||
-- unliftio-core
 | 
					-- unliftio-core
 | 
				
			||||||
import UnliftIO (MonadUnliftIO, UnliftIO(..), withUnliftIO)
 | 
					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.Text.Foreign (lengthWord8, unsafeCopyToPtr)
 | 
				
			||||||
import Data.Word (Word8)
 | 
					import Data.Word (Word8)
 | 
				
			||||||
import Foreign (castPtr, free, mallocBytes, pokeByteOff)
 | 
					import Foreign (allocaBytes, castPtr, pokeByteOff)
 | 
				
			||||||
import UnliftIO.Exception (bracket)
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
 | 
					withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
 | 
				
			||||||
withCString t = bracket create destroy
 | 
					withCString t@(Text _arr _off len) action =
 | 
				
			||||||
  where
 | 
					  withUnliftIO $ \(UnliftIO unlift) ->
 | 
				
			||||||
    size0 = lengthWord8 t + 1
 | 
					    allocaBytes (len + 1) $ \buf -> do
 | 
				
			||||||
 | 
					      unsafeCopyToPtr t buf
 | 
				
			||||||
    create = liftIO $ do
 | 
					      pokeByteOff buf len (0 :: Word8)
 | 
				
			||||||
      ptr <- mallocBytes size0
 | 
					      unlift $ action (castPtr buf)
 | 
				
			||||||
      unsafeCopyToPtr t (castPtr ptr)
 | 
					 | 
				
			||||||
      pokeByteOff ptr size0 (0 :: Word8)
 | 
					 | 
				
			||||||
      pure ptr
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
    destroy ptr =
 | 
					 | 
				
			||||||
      liftIO $ free ptr
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
#else
 | 
					#else
 | 
				
			||||||
 | 
					-- XXX: the text is UTF-16, let GHC do it
 | 
				
			||||||
 | 
					
 | 
				
			||||||
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
 | 
					withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
 | 
				
			||||||
withCString t action = do
 | 
					withCString t action = do
 | 
				
			||||||
 
 | 
				
			|||||||
		Reference in New Issue
	
	Block a user