[commit: ghc] master: NCG: correctly escape path strings on Windows (#16389) (6b2f099)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/6b2f09916e0c8c5f37c9fbe08eb076476501c8d6/ghc

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

commit 6b2f09916e0c8c5f37c9fbe08eb076476501c8d6
Author: Sylvain Henry <sylvain at haskus.fr>
Date:   Fri Mar 8 12:53:43 2019 +0100

    NCG: correctly escape path strings on Windows (#16389)
    
    GHC native code generator generates .incbin and .file directives. We
    need to escape those strings correctly on Windows (see #16389).


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

6b2f09916e0c8c5f37c9fbe08eb076476501c8d6
 compiler/nativeGen/AsmCodeGen.hs |  2 +-
 compiler/nativeGen/PprBase.hs    |  4 +++-
 compiler/utils/Outputable.hs     | 12 +++++++++++-
 3 files changed, 15 insertions(+), 3 deletions(-)

diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index b866741..84c6a84 100644
--- a/compiler/nativeGen/AsmCodeGen.hs
+++ b/compiler/nativeGen/AsmCodeGen.hs
@@ -461,7 +461,7 @@ cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap = go
                          nonDetEltsUFM $ fileIds' `minusUFM` fileIds
             -- See Note [Unique Determinism and code generation]
             pprDecl (f,n) = text "\t.file " <> ppr n <+>
-                            doubleQuotes (ftext f)
+                            pprFilePathString (unpackFS f)
 
         emitNativeCode dflags h $ vcat $
           map pprDecl newFileIds ++
diff --git a/compiler/nativeGen/PprBase.hs b/compiler/nativeGen/PprBase.hs
index 1f068c2..84f9492 100644
--- a/compiler/nativeGen/PprBase.hs
+++ b/compiler/nativeGen/PprBase.hs
@@ -143,7 +143,9 @@ pprBytes bs = sdocWithDynFlags $ \dflags ->
     else unsafePerformIO $ do
       bFile <- newTempName dflags TFL_CurrentModule ".dat"
       BS.writeFile bFile bs
-      return $ text "\t.incbin \"" <> text bFile <> text "\"\n\t.byte 0"
+      return $ text "\t.incbin "
+         <> pprFilePathString bFile -- proper escape (see #16389)
+         <> text "\n\t.byte 0"
 
 {-
 Note [Embedding large binary blobs]
diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs
index 768d247..7c2eaed 100644
--- a/compiler/utils/Outputable.hs
+++ b/compiler/utils/Outputable.hs
@@ -56,7 +56,7 @@ module Outputable (
 
         pprPrimChar, pprPrimInt, pprPrimWord, pprPrimInt64, pprPrimWord64,
 
-        pprFastFilePath,
+        pprFastFilePath, pprFilePathString,
 
         -- * Controlling the style in which output is printed
         BindingSite(..),
@@ -999,6 +999,16 @@ pprInfixVar is_operator pp_v
 pprFastFilePath :: FastString -> SDoc
 pprFastFilePath path = text $ normalise $ unpackFS path
 
+-- | Normalise, escape and render a string representing a path
+--
+-- e.g. "c:\\whatever"
+pprFilePathString :: FilePath -> SDoc
+pprFilePathString path = doubleQuotes $ text (escape (normalise path))
+   where
+      escape []        = []
+      escape ('\\':xs) = '\\':'\\':escape xs
+      escape (x:xs)    = x:escape xs
+
 {-
 ************************************************************************
 *                                                                      *