Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/b41a99bda499801fd88ef0e29b07b1e6d7a56f1b >--------------------------------------------------------------- commit b41a99bda499801fd88ef0e29b07b1e6d7a56f1b Author: Ian Lynagh <[email protected]> Date: Thu Oct 25 23:54:40 2012 +0100 Handle UTF8 correctly in GHC.Conc.labelThread; fixes #6010 >--------------------------------------------------------------- GHC/Conc/Sync.lhs | 12 +++++++----- 1 files changed, 7 insertions(+), 5 deletions(-) diff --git a/GHC/Conc/Sync.lhs b/GHC/Conc/Sync.lhs index 9b7ac82..4d289c6 100644 --- a/GHC/Conc/Sync.lhs +++ b/GHC/Conc/Sync.lhs @@ -113,12 +113,14 @@ import GHC.Base import {-# SOURCE #-} GHC.IO.Handle ( hFlush ) import {-# SOURCE #-} GHC.IO.Handle.FD ( stdout ) import GHC.IO +import GHC.IO.Encoding.UTF8 import GHC.IO.Exception import GHC.Exception +import qualified GHC.Foreign import GHC.IORef import GHC.MVar +import GHC.Ptr import GHC.Real ( fromIntegral ) -import GHC.Pack ( packCString# ) import GHC.Show ( Show(..), showString ) import GHC.Weak @@ -427,10 +429,10 @@ Other applications like the graphical Concurrent Haskell Debugger -} labelThread :: ThreadId -> String -> IO () -labelThread (ThreadId t) str = IO $ \ s -> - let !ps = packCString# str - !adr = byteArrayContents# ps in - case (labelThread# t adr s) of s1 -> (# s1, () #) +labelThread (ThreadId t) str = + GHC.Foreign.withCString utf8 str $ \(Ptr p) -> + IO $ \ s -> + case labelThread# t p s of s1 -> (# s1, () #) -- Nota Bene: 'pseq' used to be 'seq' -- but 'seq' is now defined in PrelGHC _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
