From 5a7f0deee64f32777db8b87b056b4e9ba154093f Mon Sep 17 00:00:00 2001
From: Matthew Pickering <matthewtpickering@gmail.com>
Date: Tue, 26 Apr 2022 17:52:53 +0100
Subject: Give Cmm files fake ModuleNames which include full filepath

This fixes the initialisation functions when using -prof or
-finfo-table-map.

Fixes #21370
---
 compiler/GHC/Driver/Main.hs             | 6 +++---
 compiler/GHC/Driver/Pipeline/Execute.hs | 2 +-
 2 files changed, 4 insertions(+), 4 deletions(-)

(limited to 'compiler/GHC')

diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 7fd07d31cf..b1f2b2bdac 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -1731,8 +1731,8 @@ hscInteractive hsc_env cgguts location = do
 
 ------------------------------
 
-hscCompileCmmFile :: HscEnv -> FilePath -> FilePath -> IO (Maybe FilePath)
-hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do
+hscCompileCmmFile :: HscEnv -> FilePath -> FilePath -> FilePath -> IO (Maybe FilePath)
+hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hsc_env $ do
     let dflags   = hsc_dflags hsc_env
         logger   = hsc_logger hsc_env
         hooks    = hsc_hooks hsc_env
@@ -1743,7 +1743,7 @@ hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do
         do_info_table = gopt Opt_InfoTableMap dflags
         -- Make up a module name to give the NCG. We can't pass bottom here
         -- lest we reproduce #11784.
-        mod_name = mkModuleName $ "Cmm$" ++ FilePath.takeFileName filename
+        mod_name = mkModuleName $ "Cmm$" ++ original_filename
         cmm_mod = mkHomeModule home_unit mod_name
     (cmm, ents) <- ioMsgMaybe
                $ do
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index da214cdc20..4f2c30c5a7 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -128,7 +128,7 @@ runPhase (T_Cmm pipe_env hsc_env input_fn) = do
   let dflags = hsc_dflags hsc_env
   let next_phase = hscPostBackendPhase HsSrcFile (backend dflags)
   output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env Nothing
-  mstub <- hscCompileCmmFile hsc_env input_fn output_fn
+  mstub <- hscCompileCmmFile hsc_env (src_filename pipe_env) input_fn output_fn
   stub_o <- mapM (compileStub hsc_env) mstub
   let foreign_os = maybeToList stub_o
   return (foreign_os, output_fn)
-- 
cgit v1.2.1