diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2021-10-12 19:31:44 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2021-10-12 19:31:44 -0400 |
| commit | 267e3e580cda7128af1e60529c6210801636abbb (patch) | |
| tree | 5770f29ecbbe976517a081882df9c7d7c88645c8 | |
| parent | 19ed3c735f72ba3b6beacfa939fe91e914eeb60e (diff) | |
| download | haskell-267e3e580cda7128af1e60529c6210801636abbb.tar.gz | |
hih
| -rw-r--r-- | libraries/base/GHC/Conc/Sync.hs | 4 |
1 files changed, 3 insertions, 1 deletions
diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs index 9e3553e082..af3b125a08 100644 --- a/libraries/base/GHC/Conc/Sync.hs +++ b/libraries/base/GHC/Conc/Sync.hs @@ -118,6 +118,7 @@ import GHC.IO.Exception import GHC.Exception import qualified GHC.Foreign import GHC.IORef +import GHC.List ( takeWhile ) import GHC.MVar import GHC.Ptr import GHC.Real ( fromIntegral ) @@ -635,7 +636,8 @@ threadLabel :: ThreadId -> IO (Maybe String) threadLabel (ThreadId t) = IO $ \s -> case threadLabel# t s of (# s', 1#, lbl #) -> - let lbl' = Just (utf8DecodeByteArray lbl) + let lbl' = Just (takeWhile (/= '\0') $ utf8DecodeByteArray lbl) + -- N.B. strip off the NUL terminator in (# s', lbl' #) (# s', 0#, _ #) -> (# s', Nothing #) _ -> error "threadLabel: impossible" |