Prevent GHC from silently dying when preprocessor is not found
authorTamar Christina <tamar@zhox.com>
Sat, 3 Oct 2015 10:37:00 +0000 (12:37 +0200)
committerBen Gamari <ben@smart-cactus.org>
Sat, 3 Oct 2015 11:06:24 +0000 (13:06 +0200)
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

compiler/main/GHC.hs
compiler/main/SysTools.hs
compiler/utils/Panic.hs
ghc/InteractiveUI.hs
testsuite/tests/driver/T365.hs [new file with mode: 0644]
testsuite/tests/driver/T365.stderr [new file with mode: 0644]
testsuite/tests/driver/all.T
testsuite/tests/parser/should_fail/T8430.stderr
utils/haddock

index 883cd2c..17e0359 100644 (file)
@@ -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)
index 15baa38..1efb67a 100644 (file)
@@ -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))}
 
 {-
 ************************************************************************
index e1c848d..7823336 100644 (file)
@@ -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
index 2dcedb0..80c1483 100644 (file)
@@ -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 (file)
index 0000000..fe09bb2
--- /dev/null
@@ -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 (file)
index 0000000..560217e
--- /dev/null
@@ -0,0 +1 @@
+./test_preprocessor.txt: runInteractiveProcess: invalid argument (Exec format error)
index 4a4f930..cbfbd02 100644 (file)
@@ -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,
+      [''])
index 2d7b703..31e69ba 100644 (file)
@@ -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)
index 5890a2d..e083daa 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 5890a2d503b3200e9897ce331ad61d808a67fca3
+Subproject commit e083daa4a46ae2f9a244b6bcedc5951b3a78f260