summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2019-03-08 12:53:43 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-03-09 07:42:34 -0500
commit6b2f09916e0c8c5f37c9fbe08eb076476501c8d6 (patch)
tree0e6d77fdd175d94dc50494c1279ac0ca7b8e3ff5
parent6e3e537e419ba8d02dac306d596fba3c1029f123 (diff)
downloadhaskell-6b2f09916e0c8c5f37c9fbe08eb076476501c8d6.tar.gz
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).
-rw-r--r--compiler/nativeGen/AsmCodeGen.hs2
-rw-r--r--compiler/nativeGen/PprBase.hs4
-rw-r--r--compiler/utils/Outputable.hs12
3 files changed, 15 insertions, 3 deletions
diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index b866741995..84c6a84845 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 1f068c261b..84f9492032 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 768d247bf0..7c2eaed62d 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
+
{-
************************************************************************
* *