From 0c8771664ebe2a5165f0d38b814d34cebf12d50f Mon Sep 17 00:00:00 2001
From: Matthew Pickering <matthewtpickering@gmail.com>
Date: Thu, 6 Jul 2023 11:24:53 +0100
Subject: [PATCH] driver: Fix -S with .cmm files

There was an oversight in the driver which assumed that you would always
produce a `.o` file when compiling a .cmm file.

Fixes #23610

(cherry picked from commit 76983a0dca64dfb7e94aea0c4f494921f8513b41)
---
 compiler/GHC/Driver/Pipeline.hs               | 12 ++++++------
 testsuite/tests/cmm/should_compile/Makefile   |  3 +++
 testsuite/tests/cmm/should_compile/T23610.cmm |  3 +++
 testsuite/tests/cmm/should_compile/all.T      |  1 +
 4 files changed, 13 insertions(+), 6 deletions(-)
 create mode 100644 testsuite/tests/cmm/should_compile/T23610.cmm

diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index ea5f716272f..9165de9c247 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -850,18 +850,18 @@ llvmManglePipeline pipe_env hsc_env location llc_fn = do
       else use (T_LlvmMangle pipe_env hsc_env llc_fn)
   asPipeline False pipe_env hsc_env location mangled_fn
 
-cmmCppPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m FilePath
+cmmCppPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath)
 cmmCppPipeline pipe_env hsc_env input_fn = do
   output_fn <- use (T_CmmCpp pipe_env hsc_env input_fn)
   cmmPipeline pipe_env hsc_env output_fn
 
-cmmPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m FilePath
+cmmPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath)
 cmmPipeline pipe_env hsc_env input_fn = do
   (fos, output_fn) <- use (T_Cmm pipe_env hsc_env input_fn)
   mo_fn <- hscPostBackendPipeline pipe_env hsc_env HsSrcFile (backend (hsc_dflags hsc_env)) Nothing output_fn
   case mo_fn of
-    Nothing -> panic "CMM pipeline - produced no .o file"
-    Just mo_fn -> use (T_MergeForeign pipe_env hsc_env mo_fn fos)
+    Nothing -> return Nothing
+    Just mo_fn -> Just <$> use (T_MergeForeign pipe_env hsc_env mo_fn fos)
 
 jsPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath
 jsPipeline pipe_env hsc_env location input_fn = do
@@ -938,8 +938,8 @@ pipelineStart pipe_env hsc_env input_fn mb_phase =
    fromPhase LlvmLlc    = llvmLlcPipeline pipe_env hsc_env Nothing input_fn
    fromPhase LlvmMangle = llvmManglePipeline pipe_env hsc_env Nothing input_fn
    fromPhase StopLn     = return (Just input_fn)
-   fromPhase CmmCpp     = Just <$> cmmCppPipeline pipe_env hsc_env input_fn
-   fromPhase Cmm        = Just <$> cmmPipeline pipe_env hsc_env input_fn
+   fromPhase CmmCpp     = cmmCppPipeline pipe_env hsc_env input_fn
+   fromPhase Cmm        = cmmPipeline pipe_env hsc_env input_fn
    fromPhase Js         = Just <$> foreignJsPipeline pipe_env hsc_env Nothing input_fn
    fromPhase MergeForeign = panic "fromPhase: MergeForeign"
 
diff --git a/testsuite/tests/cmm/should_compile/Makefile b/testsuite/tests/cmm/should_compile/Makefile
index 6ee7fae2e05..22aa0a0fc11 100644
--- a/testsuite/tests/cmm/should_compile/Makefile
+++ b/testsuite/tests/cmm/should_compile/Makefile
@@ -13,3 +13,6 @@ T16930:
 	grep -rl "after setInfoTableStackMap" `ls T16930.*`
 	grep -rl "Layout Stack" `ls T16930.*`
 	grep -rl "Post switch plan" `ls T16930.*`
+
+T23610:
+	'$(TEST_HC)' $(TEST_HC_OPTS) T23610.cmm -S
diff --git a/testsuite/tests/cmm/should_compile/T23610.cmm b/testsuite/tests/cmm/should_compile/T23610.cmm
new file mode 100644
index 00000000000..1484549d9c7
--- /dev/null
+++ b/testsuite/tests/cmm/should_compile/T23610.cmm
@@ -0,0 +1,3 @@
+test(bits64 x) {
+    return (x);
+}
diff --git a/testsuite/tests/cmm/should_compile/all.T b/testsuite/tests/cmm/should_compile/all.T
index 7f401591627..512e2bf6f8e 100644
--- a/testsuite/tests/cmm/should_compile/all.T
+++ b/testsuite/tests/cmm/should_compile/all.T
@@ -8,3 +8,4 @@ test('cmm_sink_sp', [ only_ways(['optasm']), grep_errmsg(r'(\[Sp.*\]).*(=).*(\[.
 test('T16930', normal, makefile_test, ['T16930'])
 test('T17442', normal, compile, [''])
 test('T20725', normal, compile, ['-package ghc'])
+test('T23610', normal, makefile_test, ['T23610'])
-- 
GitLab