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

compiler/main/DriverPhases.hs

@@ -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

compiler/main/DriverPipeline.hs

@@ -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

testsuite/tests/driver/T10219.hspp

@@ -0,0 +1 @@
+main = return ()

testsuite/tests/driver/all.T

@@ -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'])