diff options
| -rw-r--r-- | compiler/main/GHC.hs | 1 | ||||
| -rw-r--r-- | compiler/main/SysTools.hs | 16 | ||||
| -rw-r--r-- | compiler/utils/Panic.hs | 16 | ||||
| -rw-r--r-- | ghc/InteractiveUI.hs | 1 | ||||
| -rw-r--r-- | testsuite/tests/driver/T365.hs | 4 | ||||
| -rw-r--r-- | testsuite/tests/driver/T365.stderr | 1 | ||||
| -rw-r--r-- | testsuite/tests/driver/all.T | 7 | ||||
| -rw-r--r-- | testsuite/tests/parser/should_fail/T8430.stderr | 1 | ||||
| m--------- | utils/haddock | 0 |
9 files changed, 20 insertions, 27 deletions
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 883cd2c9d7..17e03591e1 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 15baa38bf5..1efb67acc2 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 e1c848d540..782333633a 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 2dcedb0b0b..80c1483863 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 0000000000..fe09bb2fb0 --- /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 0000000000..560217e498 --- /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 4a4f93003e..cbfbd02a4c 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 2d7b703e51..31e69baac7 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 -Subproject 5890a2d503b3200e9897ce331ad61d808a67fca +Subproject e083daa4a46ae2f9a244b6bcedc5951b3a78f26 |