Commit 69818626 authored by thomie's avatar thomie

Don't throw exception when start_phase==stop_phase (#10219)

Just do nothing instead. This bug only shows up when using `-x hspp` in
--make mode on registerised builds.

Reviewed By: austin

Differential Revision: https://phabricator.haskell.org/D776
parent 9e073ce4
......@@ -165,9 +165,22 @@ eqPhase Ccxx Ccxx = True
eqPhase Cobjcxx Cobjcxx = True
eqPhase _ _ = False
-- Partial ordering on phases: we want to know which phases will occur before
-- which others. This is used for sanity checking, to ensure that the
-- pipeline will stop at some point (see DriverPipeline.runPipeline).
{- Note [Partial ordering on phases]
We want to know which phases will occur before which others. This is used for
sanity checking, to ensure that the pipeline will stop at some point (see
DriverPipeline.runPipeline).
A < B iff A occurs before B in a normal compilation pipeline.
There is explicitly not a total ordering on phases, because in registerised
builds, the phase `HsC` doesn't happen before nor after any other phase.
Although we check that a normal user doesn't set the stop_phase to HsC through
use of -C with registerised builds (in Main.checkOptions), it is still
possible for a ghc-api user to do so. So be careful when using the function
happensBefore, and don't think that `not (a <= b)` implies `b < a`.
-}
happensBefore :: DynFlags -> Phase -> Phase -> Bool
happensBefore dflags p1 p2 = p1 `happensBefore'` p2
where StopLn `happensBefore'` _ = False
......
......@@ -606,14 +606,13 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase)
-- We want to catch cases of "you can't get there from here" before
-- we start the pipeline, because otherwise it will just run off the
-- end.
--
-- There is a partial ordering on phases, where A < B iff A occurs
-- before B in a normal compilation pipeline.
let happensBefore' = happensBefore dflags
case start_phase of
RealPhase start_phase' ->
when (not (start_phase' `happensBefore'` stop_phase)) $
-- See Note [Partial ordering on phases]
-- Not the same as: (stop_phase `happensBefore` start_phase')
when (not (start_phase' `happensBefore'` stop_phase ||
start_phase' `eqPhase` stop_phase)) $
throwGhcExceptionIO (UsageError
("cannot compile this file to desired target: "
++ input_fn))
......@@ -663,6 +662,7 @@ pipeLoop :: PhasePlus -> FilePath -> CompPipeline (DynFlags, FilePath)
pipeLoop phase input_fn = do
env <- getPipeEnv
dflags <- getDynFlags
-- See Note [Partial ordering on phases]
let happensBefore' = happensBefore dflags
stopPhase = stop_phase env
case phase of
......
......@@ -422,3 +422,8 @@ test('T9938B',
test('T9963', exit_code(1), run_command,
['{compiler} --interactive --print-libdir'])
test('T10219', normal, run_command,
# `-x hspp` in make mode should work.
# Note: need to specify `-x hspp` before the filename.
['{compiler} --make -x hspp T10219.hspp -fno-code -v0'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment