[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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- a/ghc/docs/users_guide/using.sgml
+++ b/ghc/docs/users_guide/using.sgml
@@ -864,6 +864,15 @@ ghc ––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