NCG: correctly escape path strings on Windows (#16389)
authorSylvain Henry <sylvain@haskus.fr>
Fri, 8 Mar 2019 11:53:43 +0000 (12:53 +0100)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Sat, 9 Mar 2019 12:42:34 +0000 (07:42 -0500)
GHC native code generator generates .incbin and .file directives. We
need to escape those strings correctly on Windows (see #16389).

compiler/nativeGen/AsmCodeGen.hs
compiler/nativeGen/PprBase.hs
compiler/utils/Outputable.hs

index b866741..84c6a84 100644 (file)
@@ -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 ++
index 1f068c2..84f9492 100644 (file)
@@ -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]
index 768d247..7c2eaed 100644 (file)
@@ -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
+
 {-
 ************************************************************************
 *                                                                      *