diff options
| -rw-r--r-- | compiler/GHC/Driver/Pipeline.hs | 31 | ||||
| -rw-r--r-- | testsuite/tests/driver/Makefile | 6 | ||||
| -rw-r--r-- | testsuite/tests/driver/T21869.hs | 3 | ||||
| -rw-r--r-- | testsuite/tests/driver/all.T | 1 |
4 files changed, 27 insertions, 14 deletions
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs index e988979df2..0149bf644f 100644 --- a/compiler/GHC/Driver/Pipeline.hs +++ b/compiler/GHC/Driver/Pipeline.hs @@ -579,7 +579,7 @@ compileForeign hsc_env lang stub_c = do LangCxx -> viaCPipeline Ccxx LangObjc -> viaCPipeline Cobjc LangObjcxx -> viaCPipeline Cobjcxx - LangAsm -> \pe hsc_env ml fp -> Just <$> asPipeline True pe hsc_env ml fp + LangAsm -> \pe hsc_env ml fp -> asPipeline True pe hsc_env ml fp #if __GLASGOW_HASKELL__ < 811 RawObject -> panic "compileForeign: should be unreachable" #endif @@ -587,6 +587,7 @@ compileForeign hsc_env lang stub_c = do res <- runPipeline (hsc_hooks hsc_env) (pipeline pipe_env hsc_env Nothing stub_c) case res of -- This should never happen as viaCPipeline should only return `Nothing` when the stop phase is `StopC`. + -- and the same should never happen for asPipeline -- Future refactoring to not check StopC for this case Nothing -> pprPanic "compileForeign" (ppr stub_c) Just fp -> return fp @@ -765,28 +766,30 @@ hscGenBackendPipeline pipe_env hsc_env mod_sum result = do return (Just linkable) return (miface, final_linkable) -asPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m ObjFile -asPipeline use_cpp pipe_env hsc_env location input_fn = do - use (T_As use_cpp pipe_env hsc_env location input_fn) +asPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe ObjFile) +asPipeline use_cpp pipe_env hsc_env location input_fn = + case stop_phase pipe_env of + StopAs -> return Nothing + _ -> Just <$> use (T_As use_cpp pipe_env hsc_env location input_fn) viaCPipeline :: P m => Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath) viaCPipeline c_phase pipe_env hsc_env location input_fn = do out_fn <- use (T_Cc c_phase pipe_env hsc_env input_fn) case stop_phase pipe_env of StopC -> return Nothing - _ -> Just <$> asPipeline False pipe_env hsc_env location out_fn + _ -> asPipeline False pipe_env hsc_env location out_fn -llvmPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath +llvmPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath) llvmPipeline pipe_env hsc_env location fp = do opt_fn <- use (T_LlvmOpt pipe_env hsc_env fp) llvmLlcPipeline pipe_env hsc_env location opt_fn -llvmLlcPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath +llvmLlcPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath) llvmLlcPipeline pipe_env hsc_env location opt_fn = do llc_fn <- use (T_LlvmLlc pipe_env hsc_env opt_fn) llvmManglePipeline pipe_env hsc_env location llc_fn -llvmManglePipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath +llvmManglePipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath) llvmManglePipeline pipe_env hsc_env location llc_fn = do mangled_fn <- if gopt Opt_NoLlvmMangler (hsc_dflags hsc_env) @@ -818,10 +821,10 @@ applyPostHscPipeline => DefunctionalizedPostHscPipeline -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath) applyPostHscPipeline NcgPostHscPipeline = - \pe he ml fp -> Just <$> asPipeline False pe he ml fp + \pe he ml fp -> asPipeline False pe he ml fp applyPostHscPipeline ViaCPostHscPipeline = viaCPipeline HCc applyPostHscPipeline LlvmPostHscPipeline = - \pe he ml fp -> Just <$> llvmPipeline pe he ml fp + \pe he ml fp -> llvmPipeline pe he ml fp applyPostHscPipeline NoPostHscPipeline = \_ _ _ _ -> return Nothing @@ -854,7 +857,7 @@ pipelineStart pipe_env hsc_env input_fn = c :: P m => Phase -> m (Maybe FilePath) c phase = viaCPipeline phase pipe_env hsc_env Nothing input_fn as :: P m => Bool -> m (Maybe FilePath) - as use_cpp = Just <$> asPipeline use_cpp pipe_env hsc_env Nothing input_fn + as use_cpp = asPipeline use_cpp pipe_env hsc_env Nothing input_fn objFromLinkable (_, Just (LM _ _ [DotO lnk])) = Just lnk objFromLinkable _ = Nothing @@ -880,9 +883,9 @@ pipelineStart pipe_env hsc_env input_fn = fromSuffix "cxx" = c Ccxx fromSuffix "s" = as False fromSuffix "S" = as True - fromSuffix "ll" = Just <$> llvmPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "bc" = Just <$> llvmLlcPipeline pipe_env hsc_env Nothing input_fn - fromSuffix "lm_s" = Just <$> llvmManglePipeline pipe_env hsc_env Nothing input_fn + fromSuffix "ll" = llvmPipeline pipe_env hsc_env Nothing input_fn + fromSuffix "bc" = llvmLlcPipeline pipe_env hsc_env Nothing input_fn + fromSuffix "lm_s" = llvmManglePipeline pipe_env hsc_env Nothing input_fn fromSuffix "o" = return (Just input_fn) fromSuffix "cmm" = Just <$> cmmCppPipeline pipe_env hsc_env input_fn fromSuffix "cmmcpp" = Just <$> cmmPipeline pipe_env hsc_env input_fn diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile index 30ca61b8e5..085ca668a4 100644 --- a/testsuite/tests/driver/Makefile +++ b/testsuite/tests/driver/Makefile @@ -773,3 +773,9 @@ T21349: "$(TEST_HC)" $(TEST_HC_OPTS) -v0 Main -working-dir T21349 [ ! -f T21349/B.o ] || (echo "object file exists" && exit 2) [ ! -f T21349/B.hi ] || (echo "interface file exists" && exit 2) + +.PHONY: T21869 +T21869: + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 T21869.hs -S + [ -f T21869.s ] || (echo "assembly file does not exist" && exit 2) + [ ! -f T21869.o ] || (echo "object file exists" && exit 2) diff --git a/testsuite/tests/driver/T21869.hs b/testsuite/tests/driver/T21869.hs new file mode 100644 index 0000000000..918e213f57 --- /dev/null +++ b/testsuite/tests/driver/T21869.hs @@ -0,0 +1,3 @@ +module Main where + +main = print () diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 624c8305dc..f38cb070db 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -309,3 +309,4 @@ test('T16476a', normal, makefile_test, []) test('T16476b', normal, makefile_test, []) test('T20569', extra_files(["T20569/"]), makefile_test, []) test('T21349', extra_files(['T21349']), makefile_test, []) +test('T21869', normal, makefile_test, []) |