summaryrefslogtreecommitdiff
path: root/ocaml-binary-annot/utils/warnings.ml
diff options
context:
space:
mode:
Diffstat (limited to 'ocaml-binary-annot/utils/warnings.ml')
-rw-r--r--ocaml-binary-annot/utils/warnings.ml342
1 files changed, 342 insertions, 0 deletions
diff --git a/ocaml-binary-annot/utils/warnings.ml b/ocaml-binary-annot/utils/warnings.ml
new file mode 100644
index 0000000000..72885523c0
--- /dev/null
+++ b/ocaml-binary-annot/utils/warnings.ml
@@ -0,0 +1,342 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Pierre Weis && Damien Doligez, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1998 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* When you change this, you need to update the documentation:
+ - man/ocamlc.m in ocaml
+ - man/ocamlopt.m in ocaml
+ - manual/cmds/comp.etex in the doc sources
+ - manual/cmds/native.etex in the doc sources
+*)
+
+type t =
+ | Comment_start (* 1 *)
+ | Comment_not_end (* 2 *)
+ | Deprecated (* 3 *)
+ | Fragile_match of string (* 4 *)
+ | Partial_application (* 5 *)
+ | Labels_omitted (* 6 *)
+ | Method_override of string list (* 7 *)
+ | Partial_match of string (* 8 *)
+ | Non_closed_record_pattern of string (* 9 *)
+ | Statement_type (* 10 *)
+ | Unused_match (* 11 *)
+ | Unused_pat (* 12 *)
+ | Instance_variable_override of string list (* 13 *)
+ | Illegal_backslash (* 14 *)
+ | Implicit_public_methods of string list (* 15 *)
+ | Unerasable_optional_argument (* 16 *)
+ | Undeclared_virtual_method of string (* 17 *)
+ | Not_principal of string (* 18 *)
+ | Without_principality of string (* 19 *)
+ | Unused_argument (* 20 *)
+ | Nonreturning_statement (* 21 *)
+ | Camlp4 of string (* 22 *)
+ | Useless_record_with (* 23 *)
+ | Bad_module_name of string (* 24 *)
+ | All_clauses_guarded (* 25 *)
+ | Unused_var of string (* 26 *)
+ | Unused_var_strict of string (* 27 *)
+ | Wildcard_arg_to_constant_constr (* 28 *)
+ | Eol_in_string (* 29 *)
+ | Duplicate_definitions of string * string * string * string (*30 *)
+;;
+
+(* If you remove a warning, leave a hole in the numbering. NEVER change
+ the numbers of existing warnings.
+ If you add a new warning, add it at the end with a new number;
+ do NOT reuse one of the holes.
+*)
+
+let number = function
+ | Comment_start -> 1
+ | Comment_not_end -> 2
+ | Deprecated -> 3
+ | Fragile_match _ -> 4
+ | Partial_application -> 5
+ | Labels_omitted -> 6
+ | Method_override _ -> 7
+ | Partial_match _ -> 8
+ | Non_closed_record_pattern _ -> 9
+ | Statement_type -> 10
+ | Unused_match -> 11
+ | Unused_pat -> 12
+ | Instance_variable_override _ -> 13
+ | Illegal_backslash -> 14
+ | Implicit_public_methods _ -> 15
+ | Unerasable_optional_argument -> 16
+ | Undeclared_virtual_method _ -> 17
+ | Not_principal _ -> 18
+ | Without_principality _ -> 19
+ | Unused_argument -> 20
+ | Nonreturning_statement -> 21
+ | Camlp4 _ -> 22
+ | Useless_record_with -> 23
+ | Bad_module_name _ -> 24
+ | All_clauses_guarded -> 25
+ | Unused_var _ -> 26
+ | Unused_var_strict _ -> 27
+ | Wildcard_arg_to_constant_constr -> 28
+ | Eol_in_string -> 29
+ | Duplicate_definitions _ -> 30
+;;
+
+let last_warning_number = 30;;
+(* Must be the max number returned by the [number] function. *)
+
+let letter = function
+ | 'a' ->
+ let rec loop i = if i = 0 then [] else i :: loop (i - 1) in
+ loop last_warning_number
+ | 'b' -> []
+ | 'c' -> [1; 2]
+ | 'd' -> [3]
+ | 'e' -> [4]
+ | 'f' -> [5]
+ | 'g' -> []
+ | 'h' -> []
+ | 'i' -> []
+ | 'j' -> []
+ | 'k' -> []
+ | 'l' -> [6]
+ | 'm' -> [7]
+ | 'n' -> []
+ | 'o' -> []
+ | 'p' -> [8]
+ | 'q' -> []
+ | 'r' -> [9]
+ | 's' -> [10]
+ | 't' -> []
+ | 'u' -> [11; 12]
+ | 'v' -> [13]
+ | 'w' -> []
+ | 'x' -> [14; 15; 16; 17; 18; 19; 20; 21; 22; 23; 24; 25; 30]
+ | 'y' -> [26]
+ | 'z' -> [27]
+ | _ -> assert false
+;;
+
+let active = Array.create (last_warning_number + 1) true;;
+let error = Array.create (last_warning_number + 1) false;;
+
+let is_active x = active.(number x);;
+let is_error x = error.(number x);;
+
+let parse_opt flags s =
+ let set i = flags.(i) <- true in
+ let clear i = flags.(i) <- false in
+ let set_all i = active.(i) <- true; error.(i) <- true in
+ let error () = raise (Arg.Bad "Ill-formed list of warnings") in
+ let rec get_num n i =
+ if i >= String.length s then i, n
+ else match s.[i] with
+ | '0'..'9' -> get_num (10 * n + Char.code s.[i] - Char.code '0') (i + 1)
+ | _ -> i, n
+ in
+ let get_range i =
+ let i, n1 = get_num 0 i in
+ if i + 2 < String.length s && s.[i] = '.' && s.[i + 1] = '.' then
+ let i, n2 = get_num 0 (i + 2) in
+ if n2 < n1 then error ();
+ i, n1, n2
+ else
+ i, n1, n1
+ in
+ let rec loop i =
+ if i >= String.length s then () else
+ match s.[i] with
+ | 'A' .. 'Z' ->
+ List.iter set (letter (Char.lowercase s.[i]));
+ loop (i+1)
+ | 'a' .. 'z' ->
+ List.iter clear (letter s.[i]);
+ loop (i+1)
+ | '+' -> loop_letter_num set (i+1)
+ | '-' -> loop_letter_num clear (i+1)
+ | '@' -> loop_letter_num set_all (i+1)
+ | c -> error ()
+ and loop_letter_num myset i =
+ if i >= String.length s then error () else
+ match s.[i] with
+ | '0' .. '9' ->
+ let i, n1, n2 = get_range i in
+ for n = n1 to min n2 last_warning_number do myset n done;
+ loop i
+ | 'A' .. 'Z' ->
+ List.iter myset (letter (Char.lowercase s.[i]));
+ loop (i+1)
+ | 'a' .. 'z' ->
+ List.iter myset (letter s.[i]);
+ loop (i+1)
+ | _ -> error ()
+ in
+ loop 0
+;;
+
+let parse_options errflag s = parse_opt (if errflag then error else active) s;;
+
+(* If you change these, don't forget to change them in man/ocamlc.m *)
+let defaults_w = "+a-4-6-7-9-27..29";;
+let defaults_warn_error = "-a";;
+
+let () = parse_options false defaults_w;;
+let () = parse_options true defaults_warn_error;;
+
+let message = function
+ | Comment_start -> "this is the start of a comment."
+ | Comment_not_end -> "this is not the end of a comment."
+ | Deprecated -> "this syntax is deprecated."
+ | Fragile_match "" ->
+ "this pattern-matching is fragile."
+ | Fragile_match s ->
+ "this pattern-matching is fragile.\n\
+ It will remain exhaustive when constructors are added to type " ^ s ^ "."
+ | Partial_application ->
+ "this function application is partial,\n\
+ maybe some arguments are missing."
+ | Labels_omitted ->
+ "labels were omitted in the application of this function."
+ | Method_override [lab] ->
+ "the method " ^ lab ^ " is overridden."
+ | Method_override (cname :: slist) ->
+ String.concat " "
+ ("the following methods are overridden by the class"
+ :: cname :: ":\n " :: slist)
+ | Method_override [] -> assert false
+ | Partial_match "" -> "this pattern-matching is not exhaustive."
+ | Partial_match s ->
+ "this pattern-matching is not exhaustive.\n\
+ Here is an example of a value that is not matched:\n" ^ s
+ | Non_closed_record_pattern s ->
+ "the following labels are not bound in this record pattern:\n" ^ s ^
+ "\nEither bind these labels explicitly or add `; _' to the pattern."
+ | Statement_type ->
+ "this expression should have type unit."
+ | Unused_match -> "this match case is unused."
+ | Unused_pat -> "this sub-pattern is unused."
+ | Instance_variable_override [lab] ->
+ "the instance variable " ^ lab ^ " is overridden.\n" ^
+ "The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)"
+ | Instance_variable_override (cname :: slist) ->
+ String.concat " "
+ ("the following instance variables are overridden by the class"
+ :: cname :: ":\n " :: slist) ^
+ "\nThe behaviour changed in ocaml 3.10 (previous behaviour was hiding.)"
+ | Instance_variable_override [] -> assert false
+ | Illegal_backslash -> "illegal backslash escape in string."
+ | Implicit_public_methods l ->
+ "the following private methods were made public implicitly:\n "
+ ^ String.concat " " l ^ "."
+ | Unerasable_optional_argument -> "this optional argument cannot be erased."
+ | Undeclared_virtual_method m -> "the virtual method "^m^" is not declared."
+ | Not_principal s -> s^" is not principal."
+ | Without_principality s -> s^" without principality."
+ | Unused_argument -> "this argument will not be used by the function."
+ | Nonreturning_statement ->
+ "this statement never returns (or has an unsound type.)"
+ | Camlp4 s -> s
+ | Useless_record_with ->
+ "this record is defined by a `with' expression,\n\
+ but no fields are borrowed from the original."
+ | Bad_module_name (modname) ->
+ "bad source file name: \"" ^ modname ^ "\" is not a valid module name."
+ | All_clauses_guarded ->
+ "bad style, all clauses in this pattern-matching are guarded."
+ | Unused_var v | Unused_var_strict v -> "unused variable " ^ v ^ "."
+ | Wildcard_arg_to_constant_constr ->
+ "wildcard pattern given as argument to a constant constructor"
+ | Eol_in_string ->
+ "unescaped end-of-line in a string constant (non-portable code)"
+ | Duplicate_definitions (kind, cname, tc1, tc2) ->
+ Printf.sprintf "the %s %s is defined in both types %s and %s."
+ kind cname tc1 tc2
+;;
+
+let nerrors = ref 0;;
+
+let print ppf w =
+ let msg = message w in
+ let num = number w in
+ let newlines = ref 0 in
+ for i = 0 to String.length msg - 1 do
+ if msg.[i] = '\n' then incr newlines;
+ done;
+ let (out, flush, newline, space) =
+ Format.pp_get_all_formatter_output_functions ppf ()
+ in
+ let countnewline x = incr newlines; newline x in
+ Format.pp_set_all_formatter_output_functions ppf out flush countnewline space;
+ Format.fprintf ppf "%d: %s" num msg;
+ Format.pp_print_flush ppf ();
+ Format.pp_set_all_formatter_output_functions ppf out flush newline space;
+ if error.(num) then incr nerrors;
+ !newlines
+;;
+
+exception Errors of int;;
+
+let check_fatal () =
+ if !nerrors > 0 then begin
+ let e = Errors !nerrors in
+ nerrors := 0;
+ raise e;
+ end;
+;;
+
+
+let descriptions =
+ [
+ 1, "Suspicious-looking start-of-comment mark.";
+ 2, "Suspicious-looking end-of-comment mark.";
+ 3, "Deprecated syntax.";
+ 4, "Fragile pattern matching: matching that will remain complete even\n\
+ \ if additional constructors are added to one of the variant types\n\
+ \ matched.";
+ 5, "Partially applied function: expression whose result has function\n\
+ \ type and is ignored.";
+ 6, "Label omitted in function application.";
+ 7, "Some methods are overridden in the class where they are defined.";
+ 8, "Partial match: missing cases in pattern-matching.";
+ 9, "Missing fields in a record pattern.";
+ 10, "Expression on the left-hand side of a sequence that doesn't have type\n\
+ \ \"unit\" (and that is not a function, see warning number 5).";
+ 11, "Redundant case in a pattern matching (unused match case).";
+ 12, "Redundant sub-pattern in a pattern-matching.";
+ 13, "Override of an instance variable.";
+ 14, "Illegal backslash escape in a string constant.";
+ 15, "Private method made public implicitly.";
+ 16, "Unerasable optional argument.";
+ 17, "Undeclared virtual method.";
+ 18, "Non-principal type.";
+ 19, "Type without principality.";
+ 20, "Unused function argument.";
+ 21, "Non-returning statement.";
+ 22, "Camlp4 warning.";
+ 23, "Useless record \"with\" clause.";
+ 24, "Bad module name: the source file name is not a valid OCaml module name.";
+ 25, "Pattern-matching with all clauses guarded. Exhaustiveness cannot be\n\
+ \ checked";
+ 26, "Suspicious unused variable: unused variable that is bound with \"let\"\n\
+ \ or \"as\", and doesn't start with an underscore (\"_\") character.";
+ 27, "Innocuous unused variable: unused variable that is not bound with\n\
+ \ \"let\" nor \"as\", and doesn't start with an underscore (\"_\")\n\
+ \ character.";
+ 28, "Wildcard pattern given as argument to a constant constructor.";
+ 29, "Unescaped end-of-line in a string constant (non-portable code).";
+ 30, "Two labels or constructors of the same name are defined in two\n\
+ \ mutually recursive types.";
+ ]
+
+let help_warnings () =
+ List.iter (fun (i, s) -> Printf.printf "%3i %s\n" i s) descriptions;
+ exit 0
View Lorry Controller Status