<div dir="ltr">The following test is done with `ghc-9.6.6`.<br><br>```<br>{-# LANGUAGE UnboxedTuples #-}<br>{-# LANGUAGE MagicHash #-}<br><br>import GHC.Base (IO(..))<br>import GHC.Exts<br>import Prelude hiding (length)<br><br>data MutByteArray = MutByteArray (MutableByteArray# RealWorld)<br><br>{-# INLINE new #-}<br>new :: Int -> IO MutByteArray<br>new (I# nbytes) = IO $ \s -><br>    case newByteArray# nbytes s of<br>        (# s', mbarr# #) -><br>           let c = MutByteArray mbarr#<br>            in (# s', c #)<br><br>{-# INLINE length #-}<br>length :: MutByteArray -> IO Int<br>length (MutByteArray arr) =<br>    IO $ \s -><br>        case getSizeofMutableByteArray# arr s of<br>            (# s1, i #) -> (# s1, I# i #)<br><br>test1 :: IO ()<br>test1 = do<br>    val <- new (-7)<br>    len <- length val<br>    print len<br><br>test2 :: IO ()<br>test2 = do<br>    val <- new (-8)<br>    len <- length val<br>    print len<br>```<br><br>`test1` succeeds and prints `-7`<br>The test prints the length for all `>= -7`<br><br>`test2` fails with `Out of memory`<br>If `length <= -8`, the test fails with `Out of memory`<br><br>This is an interesting quirk.<br><br>I expected `newByteArray#` to fail if the size given to it is `< 0` and I never<br><div>expected `getSizeofMutableByteArray#` would return a negative number.</div><div><br></div><div>Best,</div><div>Adithya<br></div></div>