4 files changed, 14 insertions, 2 deletions
diff --git a/libraries/base/Debug/Trace.hs b/libraries/base/Debug/Trace.hs
index eedacfa83f..92e5b205c8 100644
--- a/libraries/base/Debug/Trace.hs
+++ b/libraries/base/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/libraries/base/tests/T9395.hs b/libraries/base/tests/T9395.hs
new file mode 100644
index 0000000000..c86b1279b4
--- /dev/null
+++ b/libraries/base/tests/T9395.hs
@@ -0,0 +1,2 @@
+import Debug.Trace
+main = trace "333\0UUUU" $ return ()
diff --git a/libraries/base/tests/T9395.stderr b/libraries/base/tests/T9395.stderr
new file mode 100644
index 0000000000..4a4fb3f7c1
--- /dev/null
+++ b/libraries/base/tests/T9395.stderr
@@ -0,0 +1,2 @@
+333UUUU
+WARNING: previous trace message had null bytes
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index c85d7bc1eb..aa752c2a73 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -169,3 +169,4 @@ test('T8766',
       ['-O'])
 
 test('T9111', normal, compile, [''])
+test('T9395', normal, compile_and_run, [''])