From 21156a2fcf48764762c7f2209fa850024378d83a Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Fri, 29 Jul 2016 09:15:36 +0200 Subject: Classified all warnings and added various options. Now each warning either has a name and can be turned on/off, made into an error,etc. or is a warning that always will be triggered. The message of the warnings are similar to the ones emited by gcc/clang and all fit into one line. Furthermore the diagnostics are now colored if colored output is available. Bug 18004 --- cparser/Cerrors.ml | 262 ++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 249 insertions(+), 13 deletions(-) (limited to 'cparser/Cerrors.ml') diff --git a/cparser/Cerrors.ml b/cparser/Cerrors.ml index 5c077f37..f2794a2c 100644 --- a/cparser/Cerrors.ml +++ b/cparser/Cerrors.ml @@ -16,8 +16,11 @@ (* Management of errors and warnings *) open Format +open Commandline let warn_error = ref false +let error_fatal = ref false +let color_diagnostics = ref true let num_errors = ref 0 let num_warnings = ref 0 @@ -30,7 +33,7 @@ exception Abort to print its message, as opposed to [Format], and does not automatically introduce indentation and a final dot into the message. This is useful for multi-line messages. *) - + let fatal_error_raw fmt = incr num_errors; Printf.kfprintf @@ -38,23 +41,215 @@ let fatal_error_raw fmt = stderr (fmt ^^ "Fatal error; compilation aborted.\n%!") -let fatal_error fmt = +type msg_class = + | WarningMsg + | ErrorMsg + | FatalErrorMsg + | SuppressedMsg + +type warning_type = + | Unnamed + | Unknown_attribute + | Zero_length_array + | Celeven_extension + | Gnu_empty_struct + | Missing_declarations + | Constant_conversion + | Int_conversion + | Varargs + | Implicit_function_declaration + | Pointer_type_mismatch + | Compare_distinct_pointer_types + | Pedantic + | Main_return_type + | Invalid_noreturn + | Return_type + | Literal_range + | Unknown_pragmas + +let active_warnings: warning_type list ref = ref [ + Unknown_attribute; + Celeven_extension; + Gnu_empty_struct; + Missing_declarations; + Constant_conversion; + Int_conversion; + Varargs; + Implicit_function_declaration; + Pointer_type_mismatch; + Compare_distinct_pointer_types; + Main_return_type; + Invalid_noreturn; + Return_type; + Literal_range; +] + +let error_warnings: warning_type list ref = ref [] + +let string_of_warning = function + | Unnamed -> "" + | Unknown_attribute -> "unknown-attributes" + | Zero_length_array -> "zero-length-array" + | Celeven_extension -> "c11-extensions" + | Gnu_empty_struct -> "gnu-empty-struct" + | Missing_declarations -> "missing-declarations" + | Constant_conversion -> "constant_conversion" + | Int_conversion -> "int-conversion" + | Varargs -> "varargs" + | Implicit_function_declaration -> "implicit-function-declaration" + | Pointer_type_mismatch -> "pointer-type-mismatch" + | Compare_distinct_pointer_types -> "compare-distinct-pointer-types" + | Pedantic -> "pedantic" + | Main_return_type -> "main-return-type" + | Invalid_noreturn -> "invalid-noreturn" + | Return_type -> "return-type" + | Literal_range -> "literal-range" + | Unknown_pragmas -> "unknown-pragmas" + +let activate_warning w = + if not (List.mem w !active_warnings) then + active_warnings:=w::!active_warnings + +let deactivate_warning w = + active_warnings:=List.filter ((<>) w) !active_warnings; + error_warnings:= List.filter ((<>) w) !error_warnings + +let warning_as_error w = + activate_warning w; + if not (List.mem w !error_warnings) then + error_warnings := w::!error_warnings + +let warning_not_as_error w = + error_warnings:= List.filter ((<>) w) !error_warnings + +let wall () = + active_warnings:=[ + Unnamed; + Unknown_attribute; + Zero_length_array; + Celeven_extension; + Gnu_empty_struct; + Missing_declarations; + Constant_conversion; + Int_conversion; + Varargs; + Implicit_function_declaration; + Pointer_type_mismatch; + Compare_distinct_pointer_types; + Pedantic; + Main_return_type; + Invalid_noreturn; + Return_type; + Literal_range; + Unknown_pragmas; + ] + +let werror () = + error_warnings:=[ + Unnamed; + Unknown_attribute; + Zero_length_array; + Celeven_extension; + Gnu_empty_struct; + Missing_declarations; + Constant_conversion; + Int_conversion; + Varargs; + Implicit_function_declaration; + Pointer_type_mismatch; + Compare_distinct_pointer_types; + Pedantic; + Main_return_type; + Invalid_noreturn; + Return_type; + Literal_range; + Unknown_pragmas; + ] + + +let key_of_warning w = + match w with + | Unnamed -> None + | _ -> Some ("-W"^(string_of_warning w)) + +let key_add_werror = function + | None -> Some ("-Werror") + | Some s -> Some ("-Werror,"^s) + +let classify_warning w = + let key = key_of_warning w in + if List.mem w !active_warnings then + if List.mem w !error_warnings then + let key = key_add_werror key in + if !error_fatal then + FatalErrorMsg,key + else + ErrorMsg,key + else + WarningMsg,key + else + SuppressedMsg,None + +let cprintf fmt c = + if Unix.isatty Unix.stderr && !color_diagnostics then + fprintf fmt c + else + ifprintf fmt c + +let rsc fmt = + cprintf fmt "\x1b[0m" + +let bc fmt = + cprintf fmt "\x1b[1m" + +let rc fmt = + cprintf fmt "\x1b[31;1m" + +let mc fmt = + cprintf fmt "\x1b35;1m" + +let pp_key key fmt = + let key = match key with + | None -> "" + | Some s -> " ["^s^"]" in + fprintf fmt "%s%t@." key rsc + +let pp_loc fmt (filename,lineno) = + if filename <> "" then + fprintf fmt "%t%s:%d:%t" bc filename lineno rsc + +let error key loc fmt = incr num_errors; - kfprintf - (fun _ -> raise Abort) - err_formatter - ("@[" ^^ fmt ^^ ".@]@.@[Fatal error; compilation aborted.@]@.") + kfprintf (pp_key key) + err_formatter ("%a %terror:%t: %t" ^^ fmt) pp_loc loc rc rsc bc -let error fmt = +let fatal_error key loc fmt = incr num_errors; - eprintf ("@[" ^^ fmt ^^ ".@]@.") + kfprintf + (fun fmt -> pp_key key fmt;raise Abort) + err_formatter ("%a %terror:%t: %t" ^^ fmt) pp_loc loc rc rsc bc + +let warning loc ty fmt = + let kind,key = classify_warning ty in + match kind with + | ErrorMsg -> + error key loc fmt + | FatalErrorMsg -> + fatal_error key loc fmt + | WarningMsg -> + incr num_warnings; + kfprintf (pp_key key) + err_formatter ("%a %twarning:%tm: %t" ^^ fmt) pp_loc loc mc rsc bc + | SuppressedMsg -> ifprintf err_formatter fmt -let warning fmt = - incr num_warnings; - eprintf ("@[" ^^ fmt ^^ ".@]@.") +let error loc fmt = + if !error_fatal then + fatal_error None loc fmt + else + error None loc fmt -let info fmt = - eprintf ("@[" ^^ fmt ^^ ".@]@.") +let fatal_error loc fmt = + fatal_error None loc fmt let check_errors () = if !num_errors > 0 then @@ -67,4 +262,45 @@ let check_errors () = (if !num_warnings = 1 then "" else "s"); !num_errors > 0 || (!warn_error && !num_warnings > 0) +let error_option w = + let key = string_of_warning w in + [Exact ("-W"^key), Self (fun _ -> activate_warning w); + Exact ("-Wno"^key), Self (fun _ -> deactivate_warning w); + Exact ("-Werror="^key), Self (fun _ -> warning_as_error w); + Exact ("-Wno-error="^key), Self (fun _ -> warning_not_as_error w)] + +let warning_options = + error_option Unnamed @ + error_option Unknown_attribute @ + error_option Zero_length_array @ + error_option Celeven_extension @ + error_option Gnu_empty_struct @ + error_option Missing_declarations @ + error_option Constant_conversion @ + error_option Int_conversion @ + error_option Varargs @ + error_option Implicit_function_declaration @ + error_option Pointer_type_mismatch @ + error_option Compare_distinct_pointer_types @ + error_option Pedantic @ + error_option Main_return_type @ + error_option Invalid_noreturn @ + error_option Return_type @ + error_option Literal_range @ + error_option Unknown_pragmas @ + [Exact ("-Wfatal-errors"), Set error_fatal; + Exact ("-fdiagnostics-color"), Set color_diagnostics; + Exact ("-fno-diagnostics-color"), Unset color_diagnostics; + Exact ("-Werror"), Self (fun _ -> werror ()); + Exact ("-Wall"), Self (fun _ -> wall());] +let warning_help = "Diagnostic options:\n\ +\ -W Enable the specific \n\ +\ -Wno- Disable the specific \n\ +\ -Werror Make all warnings into errors\n\ +\ -Werror= Turn into an error\n\ +\ -Wno-error= Turn into a warning even if -Werror is\n\ + specified\n\ +\ -Wfatal-errors Turn all errors into fatal errors aborting the compilation\n\ +\ -fdiagnostics-color Turn on colored diagnostics\n\ +\ -fno-diagnostics-color Turn of colored diagnostics\n" -- cgit From 8a740c6d441afd980e3bdb43d1844bd23e0ad55b Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Fri, 5 Aug 2016 17:48:53 +0200 Subject: Additional test for color output. Color output is only enabled if stderr is a tty, and the environment variable TERM is not empty or dumb. Bug 18004 --- cparser/Cerrors.ml | 35 ++++++++++++++++------------------- 1 file changed, 16 insertions(+), 19 deletions(-) (limited to 'cparser/Cerrors.ml') diff --git a/cparser/Cerrors.ml b/cparser/Cerrors.ml index f2794a2c..8ee13caf 100644 --- a/cparser/Cerrors.ml +++ b/cparser/Cerrors.ml @@ -18,9 +18,10 @@ open Format open Commandline -let warn_error = ref false let error_fatal = ref false -let color_diagnostics = ref true +let color_diagnostics = + let term = try Sys.getenv "TERM" with Not_found -> "" in + ref (Unix.isatty Unix.stderr && term <> "dumb" && term <>"") let num_errors = ref 0 let num_warnings = ref 0 @@ -106,20 +107,20 @@ let string_of_warning = function | Literal_range -> "literal-range" | Unknown_pragmas -> "unknown-pragmas" -let activate_warning w = +let activate_warning w () = if not (List.mem w !active_warnings) then active_warnings:=w::!active_warnings -let deactivate_warning w = +let deactivate_warning w () = active_warnings:=List.filter ((<>) w) !active_warnings; error_warnings:= List.filter ((<>) w) !error_warnings -let warning_as_error w = - activate_warning w; +let warning_as_error w ()= + activate_warning w (); if not (List.mem w !error_warnings) then error_warnings := w::!error_warnings -let warning_not_as_error w = +let warning_not_as_error w () = error_warnings:= List.filter ((<>) w) !error_warnings let wall () = @@ -256,18 +257,14 @@ let check_errors () = eprintf "@[%d error%s detected.@]@." !num_errors (if !num_errors = 1 then "" else "s"); - if !warn_error && !num_warnings > 0 then - eprintf "@[%d error-enabled warning%s detected.@]@." - !num_warnings - (if !num_warnings = 1 then "" else "s"); - !num_errors > 0 || (!warn_error && !num_warnings > 0) + !num_errors > 0 let error_option w = let key = string_of_warning w in - [Exact ("-W"^key), Self (fun _ -> activate_warning w); - Exact ("-Wno"^key), Self (fun _ -> deactivate_warning w); - Exact ("-Werror="^key), Self (fun _ -> warning_as_error w); - Exact ("-Wno-error="^key), Self (fun _ -> warning_not_as_error w)] + [Exact ("-W"^key), Unit (activate_warning w); + Exact ("-Wno"^key), Unit (deactivate_warning w); + Exact ("-Werror="^key), Unit ( warning_as_error w); + Exact ("-Wno-error="^key), Unit ( warning_not_as_error w)] let warning_options = error_option Unnamed @ @@ -289,10 +286,10 @@ let warning_options = error_option Literal_range @ error_option Unknown_pragmas @ [Exact ("-Wfatal-errors"), Set error_fatal; - Exact ("-fdiagnostics-color"), Set color_diagnostics; + Exact ("-fdiagnostics-color"), Ignore; (* Either output supports it or no color *) Exact ("-fno-diagnostics-color"), Unset color_diagnostics; - Exact ("-Werror"), Self (fun _ -> werror ()); - Exact ("-Wall"), Self (fun _ -> wall());] + Exact ("-Werror"), Unit werror; + Exact ("-Wall"), Unit wall;] let warning_help = "Diagnostic options:\n\ \ -W Enable the specific \n\ -- cgit From 8763a45b8a5c6d51d53795573179ba66e479f288 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Wed, 31 Aug 2016 16:36:39 +0200 Subject: Added conformance warning. This warning should be triggered if a feature is used that is not part of the code CompCert C language. Bug 18004 --- cparser/Cerrors.ml | 2 ++ 1 file changed, 2 insertions(+) (limited to 'cparser/Cerrors.ml') diff --git a/cparser/Cerrors.ml b/cparser/Cerrors.ml index 046ca9b0..e1848ffa 100644 --- a/cparser/Cerrors.ml +++ b/cparser/Cerrors.ml @@ -67,6 +67,7 @@ type warning_type = | Return_type | Literal_range | Unknown_pragmas + | CompCert_conformance let active_warnings: warning_type list ref = ref [ Unknown_attribute; @@ -106,6 +107,7 @@ let string_of_warning = function | Return_type -> "return-type" | Literal_range -> "literal-range" | Unknown_pragmas -> "unknown-pragmas" + | CompCert_conformance -> "compcert-conformance" let activate_warning w () = if not (List.mem w !active_warnings) then -- cgit