From: simonpj <unknown>
Date: Wed, 20 Nov 2002 09:37:48 +0000 (+0000)
Subject: [project @ 2002-11-20 09:37:45 by simonpj]
X-Git-Tag: Approx_11550_changesets_converted~1426
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=34a10d6614fa3546b360fc13b5386b1d86848190;p=ghc-hetmet.git

[project @ 2002-11-20 09:37:45 by simonpj]
-----------------------------------------------
	Add -Werror flag, which makes warnings fatal
	-----------------------------------------------

-Werror is standard gcc-ism; it makes warnings into fatal errors
so you don't miss them in a batch compile.

Fairly easy to implement, by modifying ErrUtils.errorsFound

Suggested by Ashley Yakeley
---

diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index f5a83b9..2cb7e44 100644
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -271,6 +271,7 @@ data DynFlag
    | Opt_DoStgLinting
    | Opt_DoUSPLinting
 
+   | Opt_WarnIsError		-- -Werror; makes warnings fatal
    | Opt_WarnDuplicateExports
    | Opt_WarnHiShadows
    | Opt_WarnIncompletePatterns
diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs
index e50f07b..982b823 100644
--- a/ghc/compiler/main/DriverFlags.hs
+++ b/ghc/compiler/main/DriverFlags.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.105 2002/10/17 14:26:17 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.106 2002/11/20 09:37:48 simonpj Exp $
 --
 -- Driver flags
 --
@@ -424,6 +424,7 @@ dynamic_flags = [
 
 	------ Warning opts -------------------------------------------------
   ,  ( "W"		, NoArg (mapM_ setDynFlag   minusWOpts)    )
+  ,  ( "Werror"		, NoArg (setDynFlag   	    Opt_WarnIsError) )
   ,  ( "Wall"		, NoArg (mapM_ setDynFlag   minusWallOpts) )
   ,  ( "Wnot"		, NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */
   ,  ( "w"		, NoArg (mapM_ unSetDynFlag minusWallOpts) )
diff --git a/ghc/compiler/main/ErrUtils.lhs b/ghc/compiler/main/ErrUtils.lhs
index 9a04b72..a33098a 100644
--- a/ghc/compiler/main/ErrUtils.lhs
+++ b/ghc/compiler/main/ErrUtils.lhs
@@ -6,7 +6,7 @@
 \begin{code}
 module ErrUtils (
 	ErrMsg, WarnMsg, Message, 
-	Messages, errorsFound, warningsFound, emptyMessages,
+	Messages, errorsFound, emptyMessages,
 
 	addShortErrLocLine, addShortWarnLocLine,
 	addErrLocHdrLine, addWarnLocHdrLine, dontAddErrLoc,
@@ -95,11 +95,12 @@ type Messages = (Bag WarnMsg, Bag ErrMsg)
 emptyMessages :: Messages
 emptyMessages = (emptyBag, emptyBag)
 
-errorsFound :: Messages -> Bool
-errorsFound (warns, errs) = not (isEmptyBag errs)
-
-warningsFound :: Messages -> Bool
-warningsFound (warns, errs) = not (isEmptyBag warns)
+errorsFound :: DynFlags -> Messages -> Bool
+-- The dyn-flags are used to see if the user has specified
+-- -Werorr, which says that warnings should be fatal
+errorsFound dflags (warns, errs) 
+  | dopt Opt_WarnIsError dflags = not (isEmptyBag errs) || not (isEmptyBag warns)
+  | otherwise  		        = not (isEmptyBag errs)
 
 printErrorsAndWarnings :: Messages -> IO ()
 	-- Don't print any warnings if there are errors
diff --git a/ghc/compiler/typecheck/TcRnMonad.lhs b/ghc/compiler/typecheck/TcRnMonad.lhs
index 8233c06..550cf60 100644
--- a/ghc/compiler/typecheck/TcRnMonad.lhs
+++ b/ghc/compiler/typecheck/TcRnMonad.lhs
@@ -169,8 +169,8 @@ initTc  (HscEnv { hsc_mode   = ghci_mode,
 	eps' <- readIORef eps_var ;
 	nc'  <- readIORef nc_var ;
 	let { pcs' = PCS { pcs_EPS = eps', pcs_nc = nc' } ;
-	      final_res | errorsFound msgs = Nothing
-			| otherwise	   = maybe_res } ;
+	      final_res | errorsFound dflags msgs = Nothing
+			| otherwise	   	  = maybe_res } ;
 
 	return (pcs', final_res)
     }
@@ -400,11 +400,13 @@ tryTc m
 
 	new_errs <- readMutVar errs_var ;
 
+	dflags <- getDOpts ;
+
 	return (new_errs, 
 		case mb_r of
-		  Left exn  			 -> Nothing
-		  Right r | errorsFound new_errs -> Nothing
-			  | otherwise		 -> Just r) 
+		  Left exn  			 	-> Nothing
+		  Right r | errorsFound dflags new_errs -> Nothing
+			  | otherwise		        -> Just r) 
    }
 
 tryTcLIE :: TcM a -> TcM (Messages, Maybe a)
@@ -448,7 +450,8 @@ ifErrsM :: TcRn m r -> TcRn m r -> TcRn m r
 ifErrsM bale_out normal
  = do { errs_var <- getErrsVar ;
 	msgs <- readMutVar errs_var ;
-	if errorsFound msgs then
+	dflags <- getDOpts ;
+	if errorsFound dflags msgs then
 	   bale_out
 	else	
 	   normal }
diff --git a/ghc/docs/users_guide/flags.sgml b/ghc/docs/users_guide/flags.sgml
index 0454026..209d6f7 100644
--- a/ghc/docs/users_guide/flags.sgml
+++ b/ghc/docs/users_guide/flags.sgml
@@ -529,6 +529,12 @@
 	    <entry>dynamic</entry>
 	    <entry><option>-w</option></entry>
 	  </row>
+	  <row>
+	    <entry><option>-Werror</option></entry>
+	    <entry>make warnings fatal</entry>
+	    <entry>dynamic</entry>
+	    <entry></entry>
+	  </row>
 
 	  <row>
 	    <entry><option>-fwarn-deprecations</option></entry>
diff --git a/ghc/docs/users_guide/using.sgml b/ghc/docs/users_guide/using.sgml
index cf0b95a..09aa47d 100644
--- a/ghc/docs/users_guide/using.sgml
+++ b/ghc/docs/users_guide/using.sgml
@@ -864,6 +864,15 @@ ghc &ndash;&ndash;make Main.hs
 	</listitem>
       </varlistentry>
 
+      <varlistentry>
+	<term><option>-Werror</option>:</term>
+	<listitem>
+	  <indexterm><primary><option>-Werror</option></primary></indexterm>
+	  <para>Makes any warning into a fatal error. Useful so that you don't 
+	    miss warnings when doing batch compilation. </para>
+	</listitem>
+      </varlistentry>
+
     </variablelist>
 
     <para>The full set of warning options is described below.  To turn