From f02f00a01b598567f70e138c144d9581973802e6 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Thu, 8 Feb 2018 16:38:54 +0100 Subject: Refactor the handling of errors and warnings (#44) * Module Cerrors is now called Diagnostic and can be used in parts of CompCert other than cparser/ * Replaced eprintf error. Instead of having eprintf msg; exit 2 use the functions from the Diagnostics module. * Raise on error before calling external tools. * Added diagnostics to clightgen. * Fix error handling of AsmToJson. * Cleanup error handling of Elab and C2C. *The implementation of location printing (file & line) is simplified and correctly prints valid filenames with invalid lines. --- cfrontend/C2C.ml | 35 +++++++++++++++++++---------------- cfrontend/CPragmas.ml | 2 +- 2 files changed, 20 insertions(+), 17 deletions(-) (limited to 'cfrontend') diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index 743ffd3b..6a2c6a4e 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -120,13 +120,16 @@ let currentLocation = ref Cutil.no_loc let updateLoc l = currentLocation := l let error fmt = - Cerrors.error !currentLocation fmt + Diagnostics.error !currentLocation fmt + +let fatal_error fmt = + Diagnostics.fatal_error !currentLocation fmt let unsupported msg = - Cerrors.error !currentLocation "unsupported feature: %s" msg + Diagnostics.error !currentLocation "unsupported feature: %s" msg let warning t msg = - Cerrors.warning !currentLocation t msg + Diagnostics.warning !currentLocation t msg let string_of_errmsg msg = let string_of_err = function @@ -657,11 +660,11 @@ let checkFloatOverflow f typ = match f with | Fappli_IEEE.B754_finite _ -> () | Fappli_IEEE.B754_zero _ -> - warning Cerrors.Literal_range "magnitude of floating-point constant too small for type '%s'" typ + warning Diagnostics.Literal_range "magnitude of floating-point constant too small for type '%s'" typ | Fappli_IEEE.B754_infinity _ -> - warning Cerrors.Literal_range "magnitude of floating-point constant too large for type '%s'" typ + warning Diagnostics.Literal_range "magnitude of floating-point constant too large for type '%s'" typ | Fappli_IEEE.B754_nan _ -> - warning Cerrors.Literal_range "floating-point converts converts to 'NaN'" + warning Diagnostics.Literal_range "floating-point converts converts to 'NaN'" let convertFloat f kind = let mant = z_of_str f.C.hex (f.C.intPart ^ f.C.fracPart) 0 in @@ -783,7 +786,7 @@ let rec convertExpr env e = let e2' = convertExpr env e2 in if Cutil.is_composite_type env e1.etyp && List.mem AVolatile (Cutil.attributes_of_type env e1.etyp) then - warning Cerrors.Unnamed "assignment to an lvalue of volatile composite type, the 'volatile' qualifier is ignored"; + warning Diagnostics.Unnamed "assignment to an lvalue of volatile composite type, the 'volatile' qualifier is ignored"; ewrap (Ctyping.eassign e1' e2') | C.EBinop((C.Oadd_assign|C.Osub_assign|C.Omul_assign|C.Odiv_assign| C.Omod_assign|C.Oand_assign|C.Oor_assign|C.Oxor_assign| @@ -1080,7 +1083,7 @@ let rec convertStmt env s = | _ -> Cutil.is_debug_stmt s in if init.sdesc <> C.Sskip && not (init_debug init) then begin - warning Cerrors.Unnamed "ignored code at beginning of 'switch'"; + warning Diagnostics.Unnamed "ignored code at beginning of 'switch'"; contains_case init end; let te = convertExpr env e in @@ -1276,7 +1279,7 @@ let rec convertGlobdecls env res gl = begin match Cutil.unroll env ty with | TFun(tres, targs, va, a) -> if targs = None then - warning Cerrors.Unnamed "'%s' is declared without a function prototype" id.name; + warning Diagnostics.Unnamed "'%s' is declared without a function prototype" id.name; convertGlobdecls env (convertFundecl env d :: res) gl' | _ -> convertGlobdecls env (convertGlobvar g.gloc env d :: res) gl' @@ -1290,7 +1293,7 @@ let rec convertGlobdecls env res gl = convertGlobdecls env res gl' | C.Gpragma s -> if not (!process_pragma_hook s) then - warning Cerrors.Unknown_pragmas "unknown pragma ignored"; + warning Diagnostics.Unknown_pragmas "unknown pragma ignored"; convertGlobdecls env res gl' (** Convert struct and union declarations. @@ -1388,7 +1391,7 @@ let public_globals gl = (** Convert a [C.program] into a [Csyntax.program] *) let convertProgram p = - Cerrors.reset(); + Diagnostics.reset(); stringNum := 0; Hashtbl.clear decl_atom; Hashtbl.clear stringTable; @@ -1399,9 +1402,8 @@ let convertProgram p = let typs = convertCompositedefs env [] p in match build_composite_env typs with | Errors.Error msg -> - error "incorrect struct or union definition: %s" - (string_of_errmsg msg); - None + fatal_error "incorrect struct or union definition: %s" + (string_of_errmsg msg) | Errors.OK ce -> comp_env := ce; let gl1 = convertGlobdecls env [] p in @@ -1413,6 +1415,7 @@ let convertProgram p = prog_main = intern_string "main"; prog_types = typs; prog_comp_env = ce } in - if Cerrors.check_errors () then None else Some p' + Diagnostics.check_errors (); + p' with Env.Error msg -> - error "%s" (Env.error_message msg); None + fatal_error "%s" (Env.error_message msg) diff --git a/cfrontend/CPragmas.ml b/cfrontend/CPragmas.ml index d61af920..44660718 100644 --- a/cfrontend/CPragmas.ml +++ b/cfrontend/CPragmas.ml @@ -72,7 +72,7 @@ let process_pragma name = | "section" :: _ -> C2C.error "ill-formed `section' pragma"; true | "use_section" :: classname :: identlist -> - if identlist = [] then C2C.warning Cerrors.Unnamed "empty `use_section' pragma"; + if identlist = [] then C2C.warning Diagnostics.Unnamed "empty `use_section' pragma"; List.iter (process_use_section_pragma classname) identlist; true | "use_section" :: _ -> -- cgit