cparser/Errors.ml

   1 (* *********************************************************************)
   2 (*                                                                     *)
   3 (*              The Compcert verified compiler                         *)
   4 (*                                                                     *)
   5 (*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
   6 (*                                                                     *)
   7 (*  Copyright Institut National de Recherche en Informatique et en     *)
   8 (*  Automatique.  All rights reserved.  This file is distributed       *)
   9 (*  under the terms of the GNU General Public License as published by  *)
  10 (*  the Free Software Foundation, either version 2 of the License, or  *)
  11 (*  (at your option) any later version.  This file is also distributed *)
  12 (*  under the terms of the INRIA Non-Commercial License Agreement.     *)
  13 (*                                                                     *)
  14 (* *********************************************************************)
  15
  16 (* Management of errors and warnings *)
  17
  18 open Format
  19
  20 let warn_error = ref false
  21
  22 let num_errors = ref 0
  23 let num_warnings = ref 0
  24
  25 let reset () = num_errors := 0; num_warnings := 0
  26
  27 exception Abort
  28
  29 let fatal_error fmt =
  30   incr num_errors;
  31   kfprintf
  32     (fun _ -> raise Abort)
  33     err_formatter
  34     ("@[<hov 2>" ^^ fmt ^^ ".@]@.@[<hov 0>Fatal error.@]@.")
  35
  36 let error fmt =
  37   incr num_errors;
  38   eprintf  ("@[<hov 2>" ^^ fmt ^^ ".@]@.")
  39
  40 let warning fmt =
  41   incr num_warnings;
  42   eprintf  ("@[<hov 2>" ^^ fmt ^^ ".@]@.")
  43
  44 let check_errors () =
  45   if !num_errors > 0 then
  46     eprintf "@[<hov 0>%d error%s detected.@]@."
  47             !num_errors
  48             (if !num_errors = 1 then "" else "s");
  49   if !warn_error && !num_warnings > 0 then
  50     eprintf "@[<hov 0>%d error-enabled warning%s detected.@]@."
  51             !num_warnings
  52             (if !num_warnings = 1 then "" else "s");
  53   !num_errors > 0 || (!warn_error && !num_warnings > 0)
  54
  55