[commit: packages/base] ghc-7.8: Filter out null bytes from trace, and warn accordingly, fixing #9395. (8dcd15c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/base

On branch  : ghc-7.8
Link       : http://ghc.haskell.org/trac/ghc/changeset/8dcd15c0db12069aee0ab8193b03ccc5a0078c4b/base

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

commit 8dcd15c0db12069aee0ab8193b03ccc5a0078c4b
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date:   Mon Nov 3 07:45:11 2014 -0600

    Filter out null bytes from trace, and warn accordingly, fixing #9395.
    
    Summary:
    Previously, if you ran trace "foo\0bar", the output was truncated so
    that everything after the null byte was omitted.  This was terrible.
    Now we filter out null bytes, and emit an extra trace saying that
    null bytes were filtered out.
    
    NB: we CANNOT fix debugBelch, because all printf variants *always*
    respect null bytes, even if you're using string precision such as
    %.*s.  The alternative would have been to introduce a new function
    debugRawBelch which did not use format strings and took an explicit
    string length, but I decided we generally should avoid putting null
    bytes in our trace messages, and warn the user.
    
    Signed-off-by: Edward Z. Yang <ezyang at cs.stanford.edu>
    
    Test Plan: validate
    
    Reviewers: hvr, austin
    
    Subscribers: simonmar, relrod, ezyang, carter
    
    Differential Revision: https://phabricator.haskell.org/D121
    
    GHC Trac Issues: #9395


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

8dcd15c0db12069aee0ab8193b03ccc5a0078c4b
 Debug/Trace.hs     | 11 +++++++++--
 tests/T9395.hs     |  2 ++
 tests/T9395.stderr |  2 ++
 tests/all.T        |  1 +
 4 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/Debug/Trace.hs b/Debug/Trace.hs
index eedacfa..92e5b20 100644
--- a/Debug/Trace.hs
+++ b/Debug/Trace.hs
@@ -52,6 +52,7 @@ import qualified GHC.Foreign
 import GHC.IO.Encoding
 import GHC.Ptr
 import GHC.Stack
+import Data.List
 
 -- $tracing
 --
@@ -70,9 +71,15 @@ import GHC.Stack
 -- /Since: 4.5.0.0/
 traceIO :: String -> IO ()
 traceIO msg = do
-    withCString "%s\n" $ \cfmt ->
-     withCString msg  $ \cmsg ->
+    withCString "%s\n" $ \cfmt -> do
+     -- NB: debugBelch can't deal with null bytes, so filter them
+     -- out so we don't accidentally truncate the message.  See Trac #9395
+     let (nulls, msg') = partition (=='\0') msg
+     withCString msg' $ \cmsg ->
       debugBelch cfmt cmsg
+     when (not (null nulls)) $
+       withCString "WARNING: previous trace message had null bytes" $ \cmsg ->
+         debugBelch cfmt cmsg
 
 -- don't use debugBelch() directly, because we cannot call varargs functions
 -- using the FFI.
diff --git a/tests/T9395.hs b/tests/T9395.hs
new file mode 100644
index 0000000..c86b127
--- /dev/null
+++ b/tests/T9395.hs
@@ -0,0 +1,2 @@
+import Debug.Trace
+main = trace "333\0UUUU" $ return ()
diff --git a/tests/T9395.stderr b/tests/T9395.stderr
new file mode 100644
index 0000000..4a4fb3f
--- /dev/null
+++ b/tests/T9395.stderr
@@ -0,0 +1,2 @@
+333UUUU
+WARNING: previous trace message had null bytes
diff --git a/tests/all.T b/tests/all.T
index bec843f..5b2f40a 100644
--- a/tests/all.T
+++ b/tests/all.T
@@ -163,3 +163,4 @@ test('T8766',
 	only_ways(['normal'])],
       compile_and_run,
       ['-O'])
+test('T9395', normal, compile_and_run, [''])