[commit: base] ghc-7.6: Handle UTF8 correctly in GHC.Conc.labelThread; fixes #6010 (0e138ca)

[Paolo Capriotti]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : ghc-7.6

http://hackage.haskell.org/trac/ghc/changeset/0e138caccff86d075adc045006d441c80b24e2ca

>---------------------------------------------------------------

commit 0e138caccff86d075adc045006d441c80b24e2ca
Author: Ian Lynagh <ian at well-typed.com>
Date:   Thu Oct 25 23:54:40 2012 +0100

    Handle UTF8 correctly in GHC.Conc.labelThread; fixes #6010
    
    MERGED from commit b41a99bda499801fd88ef0e29b07b1e6d7a56f1b

>---------------------------------------------------------------

 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 5387273..3b33543 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