[commit: ghc] ghc-7.10: Fix for ticket #10078: ensure that tcPluginStop is called even in case of type errors (f163b15)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-7.10
Link       : http://ghc.haskell.org/trac/ghc/changeset/f163b15ce15cbe6ce19e168efde400a630cbf8b1/ghc

>---------------------------------------------------------------

commit f163b15ce15cbe6ce19e168efde400a630cbf8b1
Author: Jan Bracker <jan.bracker at googlemail.com>
Date:   Mon Feb 23 03:40:15 2015 -0600

    Fix for ticket #10078: ensure that tcPluginStop is called even in case of type errors
    
    Summary:
    Remove unused variable that appeared through the fix for ticket #10078
    
    Merge branch 'master' of git://git.haskell.org/ghc
    
    Added comment with bug ID.
    
    Reviewers: adamgundry, gridaphobe, austin
    
    Reviewed By: austin
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D667
    
    GHC Trac Issues: #10078
    
    (cherry picked from commit fd581a7300abede9a070cb6e9b835b2e18f68b0b)


>---------------------------------------------------------------

f163b15ce15cbe6ce19e168efde400a630cbf8b1
 compiler/typecheck/TcRnDriver.hs | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index ae1e261..b6e2973 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -2127,9 +2127,14 @@ withTcPlugins hsc_env m =
      case plugins of
        [] -> m  -- Common fast case
        _  -> do (solvers,stops) <- unzip `fmap` mapM startPlugin plugins
-                res <- updGblEnv (\e -> e { tcg_tc_plugins = solvers }) m
+                -- This ensures that tcPluginStop is called even if a type
+                -- error occurs during compilation (Fix of #10078)
+                eitherRes <- tryM $ do
+                  updGblEnv (\e -> e { tcg_tc_plugins = solvers }) m
                 mapM_ runTcPluginM stops
-                return res
+                case eitherRes of
+                  Left _ -> failM
+                  Right res -> return res
   where
   startPlugin (TcPlugin start solve stop) =
     do s <- runTcPluginM start