Cheng Shao pushed to branch wip/fix-hpc-bytecode-modname at Glasgow Haskell Compiler / GHC Commits: 704164be by Cheng Shao at 2026-05-25T13:59:10+00:00 ghci: fix module name string lifetime in hs_hpc_module invocation This patch makes hpcAddModule pass a properly malloced module name string to hs_hpc_module, instead of using useAsCString which causes use-after-free of module name string. Fixes #27297. Co-authored-by: Codex <codex@openai.com> - - - - - 4 changed files: - + libraries/ghc-boot/GHC/Data/ShortByteString.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/GHCi/Coverage.hs - libraries/ghci/GHCi/Run.hs Changes: ===================================== libraries/ghc-boot/GHC/Data/ShortByteString.hs ===================================== @@ -0,0 +1,17 @@ +module GHC.Data.ShortByteString + ( newCStringFromSBS + ) where + +import Prelude + +import qualified Data.ByteString.Short as SBS +import Foreign +import Foreign.C + +newCStringFromSBS :: SBS.ShortByteString -> IO CString +newCStringFromSBS sbs = + SBS.useAsCStringLen sbs $ \(src, len) -> do + dst <- mallocBytes (len + 1) + copyBytes dst src len + pokeByteOff dst len (0 :: Word8) + pure dst ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -51,6 +51,7 @@ Library exposed-modules: GHC.BaseDir + GHC.Data.ShortByteString GHC.Data.ShortText GHC.Data.SizedSeq GHC.Data.SmallArray ===================================== libraries/ghci/GHCi/Coverage.hs ===================================== @@ -9,9 +9,9 @@ import Prelude -- See note [Why do we import Prelude here?] import Control.Exception import Data.ByteString.Short (ShortByteString) -import qualified Data.ByteString.Short as SBS import Data.Word import Foreign +import GHC.Data.ShortByteString import GHC.Foreign (CString) import GHC.Utils.Encoding.UTF8 (utf8DecodeShortByteString) import GHCi.ObjLink (lookupSymbol) @@ -31,17 +31,19 @@ hpcAddModule :: -- ^ Name of the ticks array found in the c-stub. IO () hpcAddModule modlName ticks hash tickboxes = do - SBS.useAsCString modlName $ \modlNameLiteral -> do - -- we need to find the reference to the ticks array. - lookupSymbol tickboxes >>= \ case - Nothing -> do - -- the symbol is not found, this is a bug! - throwIO $ ErrorCall $ "hpcAddModule: failed to find symbol " <> utf8DecodeShortByteString tickboxes - Just tickBoxRef -> do - -- Calling 'hs_hpc_module' multiple times is safe, it will add the module only once. - hpc_register_module modlNameLiteral (fromIntegral ticks) (fromIntegral hash) (castPtr tickBoxRef) - -- calling 'hpc_startup' multiple times is safe, it will only be initialised once. - hpc_startup + -- we need to find the reference to the ticks array. + lookupSymbol tickboxes >>= \ case + Nothing -> do + -- the symbol is not found, this is a bug! + throwIO $ ErrorCall $ "hpcAddModule: failed to find symbol " <> utf8DecodeShortByteString tickboxes + Just tickBoxRef -> do + -- hs_hpc_module stores the module name pointer in the RTS hash table + -- until exitHpc, so pass a malloced C string. + modlNameLiteral <- newCStringFromSBS modlName + -- Calling 'hs_hpc_module' multiple times is safe, it will add the module only once. + hpc_register_module modlNameLiteral (fromIntegral ticks) (fromIntegral hash) (castPtr tickBoxRef) + -- calling 'hpc_startup' multiple times is safe, it will only be initialised once. + hpc_startup foreign import ccall unsafe "hs_hpc_module" hpc_register_module :: CString -> Word32 -> Word32 -> Ptr Word64 -> IO () ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -37,6 +37,9 @@ import Control.Monad import Data.ByteString (ByteString) import qualified Data.ByteString.Short.Internal as BS import qualified Data.ByteString.Unsafe as B +#if defined(PROFILING) +import GHC.Data.ShortByteString +#endif import GHC.Exts import qualified GHC.Exts.Heap as Heap import GHC.Stack @@ -447,13 +450,6 @@ mkCostCentres mod ccs = do c_srcspan <- newCStringFromSBS srcspan toRemotePtr <$> c_mkCostCentre c_name c_module c_srcspan - newCStringFromSBS sbs = do - let len = BS.length sbs - buf <- mallocBytes $ len + 1 - BS.copyToPtr sbs 0 buf (fromIntegral len) - pokeByteOff buf len (0 :: Word8) - pure buf - foreign import ccall unsafe "mkCostCentre" c_mkCostCentre :: Ptr CChar -> Ptr CChar -> Ptr CChar -> IO (Ptr CostCentre) #else View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/704164be09e80185ce78727a4569f8c5... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/704164be09e80185ce78727a4569f8c5... You're receiving this email because of your account on gitlab.haskell.org.