diff options
| -rw-r--r-- | compiler/nativeGen/AsmCodeGen.hs | 2 | ||||
| -rw-r--r-- | compiler/nativeGen/PprBase.hs | 4 | ||||
| -rw-r--r-- | 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 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 + {- ************************************************************************ * * |