X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FErrUtils.lhs;h=9ce02a3d2cca4353e6bdd6152cca54e3258a703e;hp=72d0e930bcb347de0c015a0b0cc2988beb892a69;hb=4c6a3f787abcaed009a574196d82237d9ae64fc8;hpb=b4229ab662b6d87b1477bafa85d2db46e5a9a152

diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs
index 72d0e93..9ce02a3 100644
--- a/compiler/main/ErrUtils.lhs
+++ b/compiler/main/ErrUtils.lhs
@@ -28,8 +28,6 @@ module ErrUtils (
 	debugTraceMsg,	
     ) where
 
--- XXX This define is a bit of a hack, and should be done more nicely
-#define FAST_STRING_NOT_NEEDED 1
 #include "HsVersions.h"
 
 import Bag		( Bag, bagToList, isEmptyBag, emptyBag )
@@ -40,6 +38,7 @@ import SrcLoc		( srcSpanStart, noSrcSpan )
 import DynFlags		( DynFlags(..), DynFlag(..), dopt )
 import StaticFlags	( opt_ErrorSpans )
 
+import Control.Monad
 import System.Exit	( ExitCode(..), exitWith )
 import Data.Dynamic
 import Data.List
@@ -128,10 +127,13 @@ errorsFound dflags (warns, errs)
 
 printErrorsAndWarnings :: DynFlags -> Messages -> IO ()
 printErrorsAndWarnings dflags (warns, errs)
-  | no_errs && no_warns  = return ()
-  | no_errs		 = printBagOfWarnings dflags warns
-			    -- Don't print any warnings if there are errors
-  | otherwise		 = printBagOfErrors   dflags errs
+  | no_errs && no_warns = return ()
+  | no_errs             = do printBagOfWarnings dflags warns
+                             when (dopt Opt_WarnIsError dflags) $
+                                 errorMsg dflags $
+                                     text "\nFailing due to -Werror.\n"
+                          -- Don't print any warnings if there are errors
+  | otherwise           = printBagOfErrors dflags errs
   where
     no_warns = isEmptyBag warns
     no_errs  = isEmptyBag errs