Commit b6f76b9a authored by Tamar Christina's avatar Tamar Christina Committed by Ben Gamari
Browse files

Prevent GHC from silently dying when preprocessor is not found

The Windows preprocessor code calls `runInteractiveProcess` but does
not check if an exception is thrown.
`runInteractiveProcess` calls `CreateProcess` which when given a format
the system loader does not know about
will throw an exception. This is what makes #9399 fail.

Ultimately we should not use any `CreateProcess` based calls but
instead `ShellExecuteEx` as  this would allow
us to run applications that the shell knows about instead of just the
loader. More details on #365.

This patch removes `PhaseFailed` and throws `ProgramError` instead.
`PhaseFailed` was largely unneeded since it never gave
very useful information aside from the `errorcode` which was almost
always `1`. `IOErrors` have also been eliminated and `GhcExceptions`
thrown in their place wherever possible.

Updates haddock submodule.

Test Plan:
`./validate` to make sure anything didn't break and
`make TESTS="T365"` to test that an error is now properly thrown

Reviewers: austin, thomie, bgamari

Reviewed By: thomie, bgamari

Subscribers: #ghc_windows_task_force

Differential Revision: https://phabricator.haskell.org/D1256

GHC Trac Issues: #365
parent 93e21b96
......@@ -398,7 +398,6 @@ defaultErrorHandler fm (FlushOut flushOut) inner =
(\ge -> liftIO $ do
flushOut
case ge of
PhaseFailed _ code -> exitWith code
Signal _ -> exitWith (ExitFailure 1)
_ -> do fatalErrorMsg'' fm (show ge)
exitWith (ExitFailure 1)
......
......@@ -1327,19 +1327,15 @@ handleProc pgm phase_name proc = do
(rc, r) <- proc `catchIO` handler
case rc of
ExitSuccess{} -> return r
ExitFailure n
-- rawSystem returns (ExitFailure 127) if the exec failed for any
-- reason (eg. the program doesn't exist). This is the only clue
-- we have, but we need to report something to the user because in
-- the case of a missing program there will otherwise be no output
-- at all.
| n == 127 -> does_not_exist
| otherwise -> throwGhcExceptionIO (PhaseFailed phase_name rc)
ExitFailure n -> throwGhcExceptionIO (
ProgramError ("`" ++ pgm ++ "'" ++
" failed in phase `" ++ phase_name ++ "'." ++
" (Exit code: " ++ show n ++ ")"))
where
handler err =
if IO.isDoesNotExistError err
then does_not_exist
else IO.ioError err
else throwGhcExceptionIO (ProgramError $ show err)
does_not_exist = throwGhcExceptionIO (InstallationError ("could not execute: " ++ pgm))
......@@ -1473,7 +1469,7 @@ traceCmd dflags phase_name cmd_line action
where
handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\n')
; debugTraceMsg dflags 2 (ptext (sLit "Failed:") <+> text cmd_line <+> text (show exn))
; throwGhcExceptionIO (PhaseFailed phase_name (ExitFailure 1)) }
; throwGhcExceptionIO (ProgramError (show exn))}
{-
************************************************************************
......
......@@ -36,7 +36,6 @@ import Control.Concurrent
import Data.Dynamic
import Debug.Trace ( trace )
import System.IO.Unsafe
import System.Exit
import System.Environment
#ifndef mingw32_HOST_OS
......@@ -63,11 +62,8 @@ import System.Mem.Weak ( Weak, deRefWeak )
-- assumed to contain a location already, so we don't print one).
data GhcException
= PhaseFailed String -- name of phase
ExitCode -- an external phase (eg. cpp) failed
-- | Some other fatal signal (SIGHUP,SIGTERM)
| Signal Int
= Signal Int
-- | Prints the short usage msg after the error
| UsageError String
......@@ -135,11 +131,6 @@ showGhcException exception
UsageError str
-> showString str . showChar '\n' . showString short_usage
PhaseFailed phase code
-> showString "phase `" . showString phase .
showString "' failed (exitcode = " . shows (int_code code) .
showString ")"
CmdLineError str -> showString str
PprProgramError str _ ->
showGhcException (ProgramError (str ++ "\n<<details unavailable>>"))
......@@ -164,11 +155,6 @@ showGhcException exception
++ " (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
++ s ++ "\n"
where int_code code =
case code of
ExitSuccess -> (0::Int)
ExitFailure x -> x
throwGhcException :: GhcException -> a
throwGhcException = Exception.throw
......
......@@ -3214,7 +3214,6 @@ showException se =
-- omit the location for CmdLineError:
Just (CmdLineError s) -> putException s
-- ditto:
Just ph@(PhaseFailed {}) -> putException (showGhcException ph "")
Just other_ghc_ex -> putException (show other_ghc_ex)
Nothing ->
case fromException se of
......
{-# OPTIONS_GHC -F -pgmF ./test_preprocessor.txt #-}
module Main where
main = print "Hello World"
./test_preprocessor.txt: runInteractiveProcess: invalid argument (Exec format error)
......@@ -446,3 +446,10 @@ test('T10182',
extra_clean(['T10182.o', 'T10182a.o', 'T10182.o-boot', 'T10182.hi', 'T10182a.hi', 'T10182.hi-boot']),
run_command,
['$MAKE -s --no-print-directory T10182'])
test('T365',
[extra_clean(['test_preprocessor.txt']),
pre_cmd('touch test_preprocessor.txt'),
unless(opsys('mingw32'), skip)],
compile_fail,
[''])
T8430.lhs line 3: unlit: spurious \end{code}
`/mnt/work/ghc/ghc-testing/inplace/lib/unlit' failed in phase `Literate pre-processor'. (Exit code: 1)
Subproject commit 5890a2d503b3200e9897ce331ad61d808a67fca3
Subproject commit e083daa4a46ae2f9a244b6bcedc5951b3a78f260
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