diff options
Diffstat (limited to 'cparser/Cerrors.ml')
| -rw-r--r-- | cparser/Cerrors.ml | 142 |
1 files changed, 120 insertions, 22 deletions
diff --git a/cparser/Cerrors.ml b/cparser/Cerrors.ml index 612980f1..dffd9c14 100644 --- a/cparser/Cerrors.ml +++ b/cparser/Cerrors.ml @@ -18,7 +18,18 @@ open Format open Commandline +(* Should errors be treated as fatal *) let error_fatal = ref false + +(* Maximum number of errors, 0 means unlimited *) +let max_error = ref 0 + +(* Whether [-Woption] should be printed *) +let diagnostics_show_option = ref true + +(* Test if color diagnostics are available by testing if stderr is a tty + and if the environment varibale TERM is set +*) let color_diagnostics = let term = try Sys.getenv "TERM" with Not_found -> "" in let activate = try @@ -29,6 +40,11 @@ let color_diagnostics = let num_errors = ref 0 let num_warnings = ref 0 + +let error_limit_reached () = + let max_err = !max_error in + max_err <> 0 && !num_errors >= max_err - 1 + let reset () = num_errors := 0; num_warnings := 0 exception Abort @@ -73,6 +89,7 @@ type warning_type = | CompCert_conformance | Inline_asm_sdump +(* List of active warnings *) let active_warnings: warning_type list ref = ref [ Unnamed; Unknown_attribute; @@ -93,8 +110,10 @@ let active_warnings: warning_type list ref = ref [ Inline_asm_sdump; ] +(* List of errors treated as warning *) let error_warnings: warning_type list ref = ref [] +(* Conversion from warning type to string *) let string_of_warning = function | Unnamed -> "" | Unknown_attribute -> "unknown-attributes" @@ -117,22 +136,27 @@ let string_of_warning = function | CompCert_conformance -> "compcert-conformance" | Inline_asm_sdump -> "inline-asm-sdump" +(* Activate the given warning *) let activate_warning w () = if not (List.mem w !active_warnings) then active_warnings:=w::!active_warnings +(* Deactivate the given warning*) let deactivate_warning w () = active_warnings:=List.filter ((<>) w) !active_warnings; error_warnings:= List.filter ((<>) w) !error_warnings +(* Activate error for warning *) let warning_as_error w ()= activate_warning w (); if not (List.mem w !error_warnings) then error_warnings := w::!error_warnings +(* Deactivate error for warning *) let warning_not_as_error w () = error_warnings:= List.filter ((<>) w) !error_warnings +(* Activate all warnings *) let wall () = active_warnings:=[ Unnamed; @@ -157,6 +181,10 @@ let wall () = Inline_asm_sdump; ] +let wnothing () = + active_warnings :=[] + +(* Make all warnings an error *) let werror () = error_warnings:=[ Unnamed; @@ -177,19 +205,29 @@ let werror () = Return_type; Literal_range; Unknown_pragmas; + CompCert_conformance; Inline_asm_sdump; ] - +(* Generate the warning key for the message *) 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) + | _ -> if !diagnostics_show_option then + Some ("-W"^(string_of_warning w)) + else + None + +(* Add -Werror to the printed keys *) +let key_add_werror w = + if !diagnostics_show_option then + match w with + | None -> Some ("-Werror") + | Some s -> Some ("-Werror,"^s) + else + None +(* Lookup how to print the warning *) let classify_warning w = let key = key_of_warning w in if List.mem w !active_warnings then @@ -204,33 +242,63 @@ let classify_warning w = else SuppressedMsg,None +(* Print color codes if color_diagnostics are enabled *) let cprintf fmt c = if !color_diagnostics then fprintf fmt c else ifprintf fmt c +(* Reset color codes *) let rsc fmt = cprintf fmt "\x1b[0m" +(* BOLD *) let bc fmt = cprintf fmt "\x1b[1m" +(* RED *) let rc fmt = cprintf fmt "\x1b[31;1m" +(* MAGENTA *) let mc fmt = cprintf fmt "\x1b[35;1m" +(* Print key (if available) and flush the formatter *) let pp_key key fmt = let key = match key with | None -> "" | Some s -> " ["^s^"]" in fprintf fmt "%s%t@." key rsc +(* Different loc output formats *) +type loc_format = + | Default + | MSVC + | Vi + +let diagnostics_format : loc_format ref = ref Default + +(* Parse the option string *) +let parse_loc_format s = + let s = String.sub s 21 ((String.length s) - 21) in + let loc_fmt = match s with + | "ccomp" -> Default + | "msvc" -> MSVC + | "vi" -> Vi + | s -> Printf.eprintf "Invalid value '%s' in '-fdiagnostics-format=%s'\n" s s; exit 2 in + diagnostics_format := loc_fmt + +(* Print the location or ccomp for the case of unknown loc *) let pp_loc fmt (filename,lineno) = if filename <> "" && lineno <> -10 && filename <> "cabs loc unknown" then - fprintf fmt "%t%s:%d:%t " bc filename lineno rsc + match !diagnostics_format with + | Default -> fprintf fmt "%t%s:%d:%t " bc filename lineno rsc + | MSVC -> fprintf fmt "%t%s(%d):%t " bc filename lineno rsc + | Vi -> fprintf fmt "%t%s +%d:%t " bc filename lineno rsc + else + fprintf fmt "%tccomp:%t " bc rsc let error key loc fmt = incr num_errors; @@ -257,7 +325,7 @@ let warning loc ty fmt = | SuppressedMsg -> ifprintf err_formatter fmt let error loc fmt = - if !error_fatal then + if !error_fatal || error_limit_reached ()then fatal_error None loc fmt else error None loc fmt @@ -276,7 +344,7 @@ let error_option w = let key = string_of_warning w in [Exact ("-W"^key), Unit (activate_warning w); Exact ("-Wno-"^key), Unit (deactivate_warning w); - Exact ("-Werror="^key), Unit ( warning_as_error w); + Exact ("-Werror="^key), Unit (warning_as_error w); Exact ("-Wno-error="^key), Unit ( warning_not_as_error w)] let warning_options = @@ -304,20 +372,50 @@ let warning_options = Exact ("-fdiagnostics-color"), Ignore; (* Either output supports it or no color *) Exact ("-fno-diagnostics-color"), Unset color_diagnostics; Exact ("-Werror"), Unit werror; - Exact ("-Wall"), Unit wall;] - -let warning_help = "Diagnostic options:\n\ -\ -Wall Enable all warnings\n\ -\ -W<warning> Enable the specific <warning>\n\ -\ -Wno-<warning> Disable the specific <warning>\n\ -\ -Werror Make all warnings into errors\n\ -\ -Werror=<warning> Turn <warning> into an error\n\ -\ -Wno-error=<warning> Turn <warning> 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" + Exact ("-Wall"), Unit wall; + Exact ("-w"), Unit wnothing; + longopt_int ("-fmax-errors") ((:=) max_error); + Exact("-fno-diagnostics-show-option"),Unset diagnostics_show_option; + Exact("-fdiagnostics-show-option"),Set diagnostics_show_option; + _Regexp("-fdiagnostics-format=\\(ccomp\\|msvc\\|vi\\)"),Self parse_loc_format; + ] + +let warning_help = {|Diagnostic options: + -Wall Enable all warnings + -W<warning> Enable the specific <warning> + -Wno-<warning> Disable the specific <warning> + -Werror Make all warnings into errors + -Werror=<warning> Turn <warning> into an error + -Wno-error=<warning> Turn <warning> into a warning even if -Werror is + specified + -Wfatal-errors Turn all errors into fatal errors aborting the compilation + -fdiagnostics-color Turn on colored diagnostics + -fno-diagnostics-color Turn of colored diagnostics + -fmax-errors=<n> Maximum number of errors to report + -fdiagnostics-show-option Print the option name with mappable diagnostics + -fno-diagnostics-show-option Turn of printing of options with mappable + diagnostics +|} let raise_on_errors () = if !num_errors > 0 then raise Abort + +let crash exn = + if Version.buildnr <> "" && Version.tag <> "" then begin + let backtrace = Printexc.get_backtrace () in + eprintf "%tThis is CompCert, %s, Build:%s, Tag:%s%t\n" + bc Version.version Version.buildnr Version.tag rsc; + eprintf "Backtrace (please include this in your support request):\n%s" + backtrace; + eprintf "%tUncaught exception: %s.\n\ +\ Please report this problem to our support.\n\ +\ Error occurred in Build: %s, Tag: %s.\n%t" + rc (Printexc.to_string exn) Version.buildnr Version.tag rsc; + exit 2 + end else begin + let backtrace = Printexc.get_backtrace () + and exc = Printexc.to_string exn in + eprintf "Fatal error: uncaught exception %s\n%s" exc backtrace; + exit 2 + end |