[commit: ghc] master: Prevent GHC from silently dying when preprocessor is not found (b6f76b9)
git at git.haskell.org
git at git.haskell.org
Sat Oct 3 11:04:23 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/b6f76b9aaca49df0fb06d8bad2f7edc5b5b8c095/ghc
>---------------------------------------------------------------
commit b6f76b9aaca49df0fb06d8bad2f7edc5b5b8c095
Author: Tamar Christina <tamar at zhox.com>
Date: Sat Oct 3 12:37:00 2015 +0200
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
>---------------------------------------------------------------
b6f76b9aaca49df0fb06d8bad2f7edc5b5b8c095
compiler/main/GHC.hs | 1 -
compiler/main/SysTools.hs | 16 ++++++----------
compiler/utils/Panic.hs | 16 +---------------
ghc/InteractiveUI.hs | 1 -
testsuite/tests/driver/T365.hs | 4 ++++
testsuite/tests/driver/T365.stderr | 1 +
testsuite/tests/driver/all.T | 7 +++++++
testsuite/tests/parser/should_fail/T8430.stderr | 1 +
utils/haddock | 2 +-
9 files changed, 21 insertions(+), 28 deletions(-)
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 883cd2c..17e0359 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -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)
diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index 15baa38..1efb67a 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -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))}
{-
************************************************************************
diff --git a/compiler/utils/Panic.hs b/compiler/utils/Panic.hs
index e1c848d..7823336 100644
--- a/compiler/utils/Panic.hs
+++ b/compiler/utils/Panic.hs
@@ -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
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 2dcedb0..80c1483 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -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
diff --git a/testsuite/tests/driver/T365.hs b/testsuite/tests/driver/T365.hs
new file mode 100644
index 0000000..fe09bb2
--- /dev/null
+++ b/testsuite/tests/driver/T365.hs
@@ -0,0 +1,4 @@
+{-# OPTIONS_GHC -F -pgmF ./test_preprocessor.txt #-}
+module Main where
+
+main = print "Hello World"
diff --git a/testsuite/tests/driver/T365.stderr b/testsuite/tests/driver/T365.stderr
new file mode 100644
index 0000000..560217e
--- /dev/null
+++ b/testsuite/tests/driver/T365.stderr
@@ -0,0 +1 @@
+./test_preprocessor.txt: runInteractiveProcess: invalid argument (Exec format error)
diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T
index 4a4f930..cbfbd02 100644
--- a/testsuite/tests/driver/all.T
+++ b/testsuite/tests/driver/all.T
@@ -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,
+ [''])
diff --git a/testsuite/tests/parser/should_fail/T8430.stderr b/testsuite/tests/parser/should_fail/T8430.stderr
index 2d7b703..31e69ba 100644
--- a/testsuite/tests/parser/should_fail/T8430.stderr
+++ b/testsuite/tests/parser/should_fail/T8430.stderr
@@ -1,2 +1,3 @@
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)
diff --git a/utils/haddock b/utils/haddock
index 5890a2d..e083daa 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit 5890a2d503b3200e9897ce331ad61d808a67fca3
+Subproject commit e083daa4a46ae2f9a244b6bcedc5951b3a78f260
More information about the ghc-commits
mailing list