diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2022-04-26 17:52:53 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-04-27 10:09:54 -0400 |
commit | 5a7f0deee64f32777db8b87b056b4e9ba154093f (patch) | |
tree | 2ca7fcd785c1a499bdfba7731ee865c8663d6da1 | |
parent | 4419dd3afe2de8b24d2dd10fe6b4c7370b861d6d (diff) | |
download | haskell-5a7f0deee64f32777db8b87b056b4e9ba154093f.tar.gz |
Give Cmm files fake ModuleNames which include full filepath
This fixes the initialisation functions when using -prof or
-finfo-table-map.
Fixes #21370
-rw-r--r-- | compiler/GHC/Driver/Main.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Driver/Pipeline/Execute.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/cmm/should_compile/T21370/Main.hs | 13 | ||||
-rw-r--r-- | testsuite/tests/cmm/should_compile/T21370/Makefile | 14 | ||||
-rw-r--r-- | testsuite/tests/cmm/should_compile/T21370/all.T | 1 | ||||
-rw-r--r-- | testsuite/tests/cmm/should_compile/T21370/subdir/test.cmm | 5 | ||||
-rw-r--r-- | testsuite/tests/cmm/should_compile/T21370/test.cmm | 5 | ||||
-rw-r--r-- | testsuite/tests/cmm/should_compile/T21370/test2.cmm | 5 |
8 files changed, 47 insertions, 4 deletions
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) diff --git a/testsuite/tests/cmm/should_compile/T21370/Main.hs b/testsuite/tests/cmm/should_compile/T21370/Main.hs new file mode 100644 index 0000000000..bcd34e1b4f --- /dev/null +++ b/testsuite/tests/cmm/should_compile/T21370/Main.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE UnliftedFFITypes #-} +module Main where + +import GHC.Int +import GHC.Prim + +foreign import prim "test" test :: Int# -> Int# +foreign import prim "test2" test2 :: Int# -> Int# +foreign import prim "test3" test3 :: Int# -> Int# + +main = print (I# (test3 (test2 (test 0#)))) diff --git a/testsuite/tests/cmm/should_compile/T21370/Makefile b/testsuite/tests/cmm/should_compile/T21370/Makefile new file mode 100644 index 0000000000..0c2bcd11f4 --- /dev/null +++ b/testsuite/tests/cmm/should_compile/T21370/Makefile @@ -0,0 +1,14 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +## check if -ddump-cmm-verbose -ddump-to-file generates files +# for all cmm stages and dumps correspond to correct procs +T21370: + '$(TEST_HC)' $(TEST_HC_OPTS) -c test.cmm -finfo-table-map + '$(TEST_HC)' $(TEST_HC_OPTS) -c test2.cmm -finfo-table-map + '$(TEST_HC)' $(TEST_HC_OPTS) -c subdir/test.cmm -finfo-table-map + '$(TEST_HC)' $(TEST_HC_OPTS) -c Main.hs -finfo-table-map + '$(TEST_HC)' $(TEST_HC_OPTS) Main.o test.o test2.o subdir/test.o + + diff --git a/testsuite/tests/cmm/should_compile/T21370/all.T b/testsuite/tests/cmm/should_compile/T21370/all.T new file mode 100644 index 0000000000..a88bb4d26f --- /dev/null +++ b/testsuite/tests/cmm/should_compile/T21370/all.T @@ -0,0 +1 @@ +test('T21370', [extra_files(["subdir", "test.cmm", "test2.cmm", "Main.hs"])] , makefile_test, []) diff --git a/testsuite/tests/cmm/should_compile/T21370/subdir/test.cmm b/testsuite/tests/cmm/should_compile/T21370/subdir/test.cmm new file mode 100644 index 0000000000..95503df8af --- /dev/null +++ b/testsuite/tests/cmm/should_compile/T21370/subdir/test.cmm @@ -0,0 +1,5 @@ +#include "Cmm.h" +test3 (W_ r1) + { + return (r1); + } diff --git a/testsuite/tests/cmm/should_compile/T21370/test.cmm b/testsuite/tests/cmm/should_compile/T21370/test.cmm new file mode 100644 index 0000000000..13e3aa3ebb --- /dev/null +++ b/testsuite/tests/cmm/should_compile/T21370/test.cmm @@ -0,0 +1,5 @@ +#include "Cmm.h" +test (W_ r1) + { + return (r1); + } diff --git a/testsuite/tests/cmm/should_compile/T21370/test2.cmm b/testsuite/tests/cmm/should_compile/T21370/test2.cmm new file mode 100644 index 0000000000..c591feecb6 --- /dev/null +++ b/testsuite/tests/cmm/should_compile/T21370/test2.cmm @@ -0,0 +1,5 @@ +#include "Cmm.h" +test2 (W_ r1) + { + return (r1); + } |