option -warn-error

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@3283 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

11 files changed, 65 insertions, 18 deletions

diff --git a/driver/compile.ml b/driver/compile.ml
index ef176394b..50346fb0e 100644
--- a/driver/compile.ml
+++ b/driver/compile.ml
@@ -108,6 +108,7 @@ let interface ppf sourcefile =
   let sg = Typemod.transl_signature (initial_env()) ast in
   if !Clflags.print_types
     then fprintf std_formatter "%a@." Printtyp.signature sg;
+  Warnings.check_fatal ();
   Env.save_signature sg modulename (prefixname ^ ".cmi");
   remove_preprocessed inputfile
 
@@ -138,8 +139,9 @@ let implementation ppf sourcefile =
     ++ Bytegen.compile_implementation modulename
     ++ print_if ppf Clflags.dump_instr Printinstr.instrlist
     ++ Emitcode.to_file oc modulename;
+    Warnings.check_fatal ();
     remove_preprocessed inputfile;
-    close_out oc
+    close_out oc;
   with x ->
     close_out oc;
     remove_file objfile;
diff --git a/driver/errors.ml b/driver/errors.ml
index 3256a7099..a6d970802 100644
--- a/driver/errors.ml
+++ b/driver/errors.ml
@@ -55,6 +55,8 @@ let report_error ppf exn =
       Location.print ppf loc; Typeclass.report_error ppf err
   | Translclass.Error(loc, err) ->
       Location.print ppf loc; Translclass.report_error ppf err
+  | Warnings.Errors (n) ->
+      fprintf ppf "@.Error: %d error-enabled warnings occurred." n
   | x -> fprintf ppf "@]"; raise x in
 
   fprintf ppf "@[%a@]@." report exn
diff --git a/driver/main.ml b/driver/main.ml
index 46784805d..b89840724 100644
--- a/driver/main.ml
+++ b/driver/main.ml
@@ -91,7 +91,8 @@ module Options = Main_args.Make_options (struct
   let _use_prims s = use_prims := s
   let _use_runtime s = use_runtime := s
   let _v = print_version_number
-  let _w = Warnings.parse_options
+  let _w = (Warnings.parse_options false)
+  let _warn_error = (Warnings.parse_options true)
   let _verbose = set verbose
   let _nopervasives = set nopervasives
   let _dparsetree = set dump_parsetree
diff --git a/driver/main_args.ml b/driver/main_args.ml
index d32b5b935..342ad2939 100644
--- a/driver/main_args.ml
+++ b/driver/main_args.ml
@@ -42,6 +42,8 @@ module Make_options (F :
      val _v : unit -> unit
      val _verbose : unit -> unit
      val _w : string -> unit
+     val _warn_error : string -> unit
+
      val _nopervasives : unit -> unit
      val _dparsetree : unit -> unit
      val _drawlambda : unit -> unit
@@ -105,7 +107,11 @@ struct
       \032    U/u enable/disable unused match case\n\
       \032    V/v enable/disable hidden instance variable\n\
       \032    X/x enable/disable all other warnings\n\
-      \032    default setting is A (all warnings enabled)";
+      \032    default setting is \"A\" (all warnings enabled)";
+    "-warn-error" , Arg.String F._warn_error,
+      "<flags>  Treat the warnings enabled by <flags> as errors.\n\
+        \032    See option -w for the list of flags.\n\
+        \032    Default setting is \"a\" (warnings are not errors)";
 
     "-nopervasives", Arg.Unit F._nopervasives, " (undocumented)";
     "-dparsetree", Arg.Unit F._dparsetree, " (undocumented)";
diff --git a/driver/main_args.mli b/driver/main_args.mli
index deda71d3e..e907edae9 100644
--- a/driver/main_args.mli
+++ b/driver/main_args.mli
@@ -42,6 +42,8 @@ module Make_options (F :
       val _v : unit -> unit
       val _verbose : unit -> unit
       val _w : string -> unit
+      val _warn_error : string -> unit
+
       val _nopervasives : unit -> unit
       val _dparsetree : unit -> unit
       val _drawlambda : unit -> unit
diff --git a/driver/optmain.ml b/driver/optmain.ml
index 62e8e655e..d3a6fff34 100644
--- a/driver/optmain.ml
+++ b/driver/optmain.ml
@@ -109,7 +109,7 @@ let main () =
              " No bounds checking on array and string access";
        "-v", Arg.Unit print_version_number, " Print compiler version number";
        "-verbose", Arg.Set verbose, " Print calls to external commands";
-       "-w", Arg.String Warnings.parse_options,
+       "-w", Arg.String (Warnings.parse_options false),
              "<flags>  Enable or disable warnings according to <flags>:\n\
          \032    A/a enable/disable all warnings\n\
          \032    C/c enable/disable suspicious comment\n\
@@ -121,6 +121,10 @@ let main () =
          \032    V/v enable/disable hidden instance variables\n\
          \032    X/x enable/disable all other warnings\n\
          \032    default setting is A (all warnings enabled)";
+       "-warn-error" , Arg.String (Warnings.parse_options true),
+         "<flags>  Enable or disable fatal warnings according to <flags>\n\
+           \032    (see option -w for the list of flags)\n\
+           \032    default setting is a (all warnings are non-fatal)";
 
        "-nopervasives", Arg.Set nopervasives, " (undocumented)";
        "-dparsetree", Arg.Set dump_parsetree, " (undocumented)";
diff --git a/parsing/location.ml b/parsing/location.ml
index e9b64c5be..984c29792 100644
--- a/parsing/location.ml
+++ b/parsing/location.ml
@@ -116,7 +116,7 @@ let print ppf loc =
 
 let print_warning loc ppf w =
  if Warnings.is_active w then begin
-  fprintf ppf "%aWarning: %s@." print loc (Warnings.message w);
+  fprintf ppf "%aWarning: %a@." print loc Warnings.print w;
   incr num_loc_lines;
  end
 ;;
diff --git a/tools/.depend b/tools/.depend
index 5bf8adb27..c2547b1ad 100644
--- a/tools/.depend
+++ b/tools/.depend
@@ -10,12 +10,8 @@ dumpobj.cmx: ../parsing/asttypes.cmi ../bytecomp/bytesections.cmx \
     ../utils/config.cmx ../bytecomp/emitcode.cmx ../typing/ident.cmx \
     ../bytecomp/instruct.cmx ../bytecomp/lambda.cmx ../bytecomp/opcodes.cmx \
     opnames.cmx ../utils/tbl.cmx 
-lexer299.cmo: ../parsing/location.cmi ../utils/misc.cmi ../utils/warnings.cmi 
-lexer299.cmx: ../parsing/location.cmx ../utils/misc.cmx ../utils/warnings.cmx 
 objinfo.cmo: ../utils/config.cmi ../bytecomp/emitcode.cmi 
 objinfo.cmx: ../utils/config.cmx ../bytecomp/emitcode.cmx 
-ocaml299to3.cmo: lexer299.cmo 
-ocaml299to3.cmx: lexer299.cmx 
 ocamlcp.cmo: ../driver/main_args.cmi 
 ocamlcp.cmx: ../driver/main_args.cmx 
 ocamldep.cmo: ../utils/clflags.cmo ../parsing/lexer.cmi \
diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml
index b2f147c45..bb5b7b075 100644
--- a/tools/ocamlcp.ml
+++ b/tools/ocamlcp.ml
@@ -61,6 +61,7 @@ module Options = Main_args.Make_options (struct
   let _v = option "-v"
   let _verbose = option "-verbose"
   let _w = option_with_arg "-w"
+  let _warn_error = option_with_arg "-warn-error"
   let _nopervasives = option "-nopervasives"
   let _dparsetree = option "-dparsetree"
   let _drawlambda = option "-drawlambda"
diff --git a/utils/warnings.ml b/utils/warnings.ml
index 33c85ba36..28bf42456 100644
--- a/utils/warnings.ml
+++ b/utils/warnings.ml
@@ -41,7 +41,8 @@ let check c =
   with _ -> raise (Arg.Bad (Printf.sprintf "unknown warning option %c" c))
 ;;    
 
-let flags = Array.create 26 true;;
+let active = Array.create 26 true;;
+let error = Array.create 26 false;;
 
 let translate c =
   check c;
@@ -51,7 +52,18 @@ let translate c =
     (Char.code c - Char.code 'a', false)
 ;;
 
-let parse_options s =
+let is_active x =
+  let (n, _) = translate (letter x) in
+  active.(n)
+;;
+
+let is_error x =
+  let (n, _) = translate (letter x) in
+  error.(n)
+;;
+
+let parse_options iserr s =
+  let flags = if iserr then error else active in
   for i = 0 to String.length s - 1 do
     if s.[i] = 'A' then Array.fill flags 0 (Array.length flags) true
     else if s.[i] = 'a' then Array.fill flags 0 (Array.length flags) false
@@ -62,11 +74,6 @@ let parse_options s =
   done
 ;;
 
-let is_active x =
-  let (n, _) = translate (letter x) in
-  flags.(n)
-;;
-
 let message = function
   | Partial_match "" -> "this pattern-matching is not exhaustive."
   | Partial_match s ->
@@ -88,3 +95,21 @@ let message = function
   | Comment s -> "this is " ^ s ^ "."
   | Other s -> s
 ;;
+
+let nerrors = ref 0;;
+
+let print ppf w =
+  Format.fprintf ppf "%s" (message w);
+  let (n, _) = translate (letter w) in
+  if error.(n) then incr nerrors;
+;;
+
+exception Errors of int;;
+
+let check_fatal () =
+  if !nerrors > 0 then begin
+    let e = Errors !nerrors in
+    nerrors := 0;
+    raise e;
+  end;
+;;
diff --git a/utils/warnings.mli b/utils/warnings.mli
index 16106c30f..b352e6b34 100644
--- a/utils/warnings.mli
+++ b/utils/warnings.mli
@@ -12,6 +12,8 @@
 
 (* $Id$ *)
 
+open Format
+
 type t =                             (* A is all *)
   | Comment of string                (* C *)
   | Partial_application              (* F *)
@@ -23,8 +25,14 @@ type t =                             (* A is all *)
   | Other of string                  (* X *)
 ;;
 
-val parse_options : string -> unit;;
+val parse_options : iserror:bool -> string -> unit;;
 
 val is_active : t -> bool;;
+val is_error : t -> bool;;
+
+val print : formatter -> t -> unit;;
+
+
+exception Errors of int;;
 
-val message : t -> string;;
+val check_fatal : unit -> unit;;