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.

2 files changed, 20 insertions, 17 deletions

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" :: _ ->