(***********************************************************************) (* *) (* OCaml *) (* *) (* 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. *) (* *) (***********************************************************************) (* 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 of string (* 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 *) | Preprocessor 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 *) | Multiple_definition of string * string * string (* 31 *) | Unused_value_declaration of string (* 32 *) | Unused_open of string (* 33 *) | Unused_type_declaration of string (* 34 *) | Unused_for_index of string (* 35 *) | Unused_ancestor of string (* 36 *) | Unused_constructor of string * bool * bool (* 37 *) | Unused_extension of string * bool * bool (* 38 *) | Unused_rec_flag (* 39 *) | Name_out_of_scope of string * string list * bool (* 40 *) | Ambiguous_name of string list * string list * bool (* 41 *) | Disambiguated_name of string (* 42 *) | Nonoptional_label of string (* 43 *) | Open_shadow_identifier of string * string (* 44 *) | Open_shadow_label_constructor of string * string (* 45 *) | Bad_env_variable of string * string (* 46 *) | Attribute_payload of string * string (* 47 *) | Eliminated_optional_arguments of string list (* 48 *) | No_cmi_file of string (* 49 *) ;; (* 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 | Preprocessor _ -> 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 | Multiple_definition _ -> 31 | Unused_value_declaration _ -> 32 | Unused_open _ -> 33 | Unused_type_declaration _ -> 34 | Unused_for_index _ -> 35 | Unused_ancestor _ -> 36 | Unused_constructor _ -> 37 | Unused_extension _ -> 38 | Unused_rec_flag -> 39 | Name_out_of_scope _ -> 40 | Ambiguous_name _ -> 41 | Disambiguated_name _ -> 42 | Nonoptional_label _ -> 43 | Open_shadow_identifier _ -> 44 | Open_shadow_label_constructor _ -> 45 | Bad_env_variable _ -> 46 | Attribute_payload _ -> 47 | Eliminated_optional_arguments _ -> 48 | No_cmi_file _ -> 49 ;; let last_warning_number = 49 (* 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' -> [32; 33; 34; 35; 36; 37; 38; 39] | '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;; type state = bool array * bool array let backup () = (Array.copy active, Array.copy error) let restore (a, e) = assert(Array.length a = Array.length active); assert(Array.length e = Array.length error); Array.blit a 0 active 0 (Array.length active); Array.blit e 0 error 0 (Array.length error) 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-32..39-41..42-44-45-48";; 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 s -> "deprecated feature: " ^ s | 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.)" | Preprocessor s -> s | Useless_record_with -> "all the fields are explicitly listed in this record:\n\ the 'with' clause is useless." | 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 | Multiple_definition(modname, file1, file2) -> Printf.sprintf "files %s and %s both define a module named %s" file1 file2 modname | Unused_value_declaration v -> "unused value " ^ v ^ "." | Unused_open s -> "unused open " ^ s ^ "." | Unused_type_declaration s -> "unused type " ^ s ^ "." | Unused_for_index s -> "unused for-loop index " ^ s ^ "." | Unused_ancestor s -> "unused ancestor variable " ^ s ^ "." | Unused_constructor (s, false, false) -> "unused constructor " ^ s ^ "." | Unused_constructor (s, true, _) -> "constructor " ^ s ^ " is never used to build values.\n\ (However, this constructor appears in patterns.)" | Unused_constructor (s, false, true) -> "constructor " ^ s ^ " is never used to build values.\n\ Its type is exported as a private type." | Unused_extension (s, false, false) -> "unused extension constructor " ^ s ^ "." | Unused_extension (s, true, _) -> "extension constructor " ^ s ^ " is never used to build values.\n\ (However, this constructor appears in patterns.)" | Unused_extension (s, false, true) -> "extension constructor " ^ s ^ " is never used to build values.\n\ It is exported or rebound as a private extension." | Unused_rec_flag -> "unused rec flag." | Name_out_of_scope (ty, [nm], false) -> nm ^ " was selected from type " ^ ty ^ ".\nIt is not visible in the current scope, and will not \n\ be selected if the type becomes unknown." | Name_out_of_scope (_, _, false) -> assert false | Name_out_of_scope (ty, slist, true) -> "this record of type "^ ty ^" contains fields that are \n\ not visible in the current scope: " ^ String.concat " " slist ^ ".\n\ They will not be selected if the type becomes unknown." | Ambiguous_name ([s], tl, false) -> s ^ " belongs to several types: " ^ String.concat " " tl ^ "\nThe first one was selected. Please disambiguate if this is wrong." | Ambiguous_name (_, _, false) -> assert false | Ambiguous_name (slist, tl, true) -> "these field labels belong to several types: " ^ String.concat " " tl ^ "\nThe first one was selected. Please disambiguate if this is wrong." | Disambiguated_name s -> "this use of " ^ s ^ " required disambiguation." | Nonoptional_label s -> "the label " ^ s ^ " is not optional." | Open_shadow_identifier (kind, s) -> Printf.sprintf "this open statement shadows the %s identifier %s (which is later used)" kind s | Open_shadow_label_constructor (kind, s) -> Printf.sprintf "this open statement shadows the %s %s (which is later used)" kind s | Bad_env_variable (var, s) -> Printf.sprintf "illegal environment variable %s : %s" var s | Attribute_payload (a, s) -> Printf.sprintf "illegal payload for attribute '%s'.\n%s" a s | Eliminated_optional_arguments sl -> Printf.sprintf "implicit elimination of optional argument%s %s" (if List.length sl = 1 then "" else "s") (String.concat ", " sl) | No_cmi_file s -> "no cmi file was found in path for module " ^ s ;; 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 feature."; 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, "Method overridden."; 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, "Instance variable overridden."; 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, "Proprocessor 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\n\ \ with \"let\" or \"as\", and doesn't start with an underscore (\"_\")\n\ \ 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."; 31, "A module is linked twice in the same executable."; 32, "Unused value declaration."; 33, "Unused open statement."; 34, "Unused type declaration."; 35, "Unused for-loop index."; 36, "Unused ancestor variable."; 37, "Unused constructor."; 38, "Unused extension constructor."; 39, "Unused rec flag."; 40, "Constructor or label name used out of scope."; 41, "Ambiguous constructor or label name."; 42, "Disambiguated constructor or label name."; 43, "Nonoptional label applied as optional."; 44, "Open statement shadows an already defined identifier."; 45, "Open statement shadows an already defined label or constructor."; 46, "Illegal environment variable."; 47, "Illegal attribute payload."; 48, "Implicit elimination of optional arguments."; 49, "Absent cmi file when looking up module alias."; ] ;; let help_warnings () = List.iter (fun (i, s) -> Printf.printf "%3i %s\n" i s) descriptions; print_endline " A All warnings."; for i = Char.code 'b' to Char.code 'z' do let c = Char.chr i in match letter c with | [] -> () | [n] -> Printf.printf " %c Synonym for warning %i.\n" (Char.uppercase c) n | l -> Printf.printf " %c Set of warnings %s.\n" (Char.uppercase c) (String.concat ", " (List.map string_of_int l)) done; exit 0 ;;