diff options
| -rw-r--r-- | bytecomp/bytelibrarian.ml | 7 | ||||
| -rw-r--r-- | bytecomp/bytelink.ml | 7 | ||||
| -rw-r--r-- | bytecomp/bytepackager.ml | 7 | ||||
| -rw-r--r-- | bytecomp/symtable.ml | 7 | ||||
| -rw-r--r-- | driver/errors.ml | 28 | ||||
| -rw-r--r-- | driver/opterrors.ml | 6 | ||||
| -rw-r--r-- | ocamldoc/odoc_analyse.ml | 23 | ||||
| -rw-r--r-- | parsing/location.ml | 13 |
8 files changed, 53 insertions, 45 deletions
diff --git a/bytecomp/bytelibrarian.ml b/bytecomp/bytelibrarian.ml index fdcb0d882..c63cf80ec 100644 --- a/bytecomp/bytelibrarian.ml +++ b/bytecomp/bytelibrarian.ml @@ -117,3 +117,10 @@ let report_error ppf = function | Not_an_object_file name -> fprintf ppf "The file %a is not a bytecode object file" Location.print_filename name + +let () = + Location.register_error_of_exn + (function + | Error err -> Some (Location.error_of_printer_file report_error err) + | _ -> None + ) diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml index b1660e9a3..75db3533c 100644 --- a/bytecomp/bytelink.ml +++ b/bytecomp/bytelink.ml @@ -622,3 +622,10 @@ let report_error ppf = function | Not_compatible_32 -> fprintf ppf "Generated bytecode executable cannot be run\ \ on a 32-bit platform" + +let () = + Location.register_error_of_exn + (function + | Error err -> Some (Location.error_of_printer_file report_error err) + | _ -> None + ) diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml index f548c771a..8ba2f5321 100644 --- a/bytecomp/bytepackager.ml +++ b/bytecomp/bytepackager.ml @@ -276,3 +276,10 @@ let report_error ppf = function Location.print_filename file name id | File_not_found file -> fprintf ppf "File %s not found" file + +let () = + Location.register_error_of_exn + (function + | Error err -> Some (Location.error_of_printer_file report_error err) + | _ -> None + ) diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml index 412c1ab09..9c94c9046 100644 --- a/bytecomp/symtable.ml +++ b/bytecomp/symtable.ml @@ -372,3 +372,10 @@ let report_error ppf = function fprintf ppf "Cannot find or execute the runtime system %s" s | Uninitialized_global s -> fprintf ppf "The value of the global `%s' is not yet computed" s + +let () = + Location.register_error_of_exn + (function + | Error err -> Some (Location.error_of_printer_file report_error err) + | _ -> None + ) diff --git a/driver/errors.ml b/driver/errors.ml index 011067adb..4f8a4eb3e 100644 --- a/driver/errors.ml +++ b/driver/errors.ml @@ -20,29 +20,9 @@ open Format (* Report an error *) let report_error ppf exn = - let report ppf = function - | Symtable.Error code -> - Location.print_error_cur_file ppf; - Symtable.report_error ppf code - | Bytelink.Error code -> - Location.print_error_cur_file ppf; - Bytelink.report_error ppf code - | Bytelibrarian.Error code -> - Location.print_error_cur_file ppf; - Bytelibrarian.report_error ppf code - | Bytepackager.Error code -> - Location.print_error_cur_file ppf; - Bytepackager.report_error ppf code - | Sys_error msg -> - Location.print_error_cur_file ppf; - fprintf ppf "I/O error: %s" msg - | Warnings.Errors (n) -> - Location.print_error_cur_file ppf; - fprintf ppf "Some fatal warnings were triggered (%d occurrences)" n - | x -> - match Location.error_of_exn x with - | Some err -> Location.report_error ppf err - | None -> fprintf ppf "@]"; raise x + let report ppf x = + match Location.error_of_exn x with + | Some err -> Location.report_error ppf err + | None -> fprintf ppf "@]"; raise x in - fprintf ppf "@[%a@]@." report exn diff --git a/driver/opterrors.ml b/driver/opterrors.ml index 94bf18453..d516707db 100644 --- a/driver/opterrors.ml +++ b/driver/opterrors.ml @@ -35,12 +35,6 @@ let report_error ppf exn = | Asmpackager.Error code -> Location.print_error_cur_file ppf; Asmpackager.report_error ppf code - | Sys_error msg -> - Location.print_error_cur_file ppf; - fprintf ppf "I/O error: %s" msg - | Warnings.Errors (n) -> - Location.print_error_cur_file ppf; - fprintf ppf "Some fatal warnings were triggered (%d occurrences)" n | x -> match Location.error_of_exn x with | Some err -> Location.report_error ppf err diff --git a/ocamldoc/odoc_analyse.ml b/ocamldoc/odoc_analyse.ml index 48a0262b9..7dd2e4456 100644 --- a/ocamldoc/odoc_analyse.ml +++ b/ocamldoc/odoc_analyse.ml @@ -107,21 +107,14 @@ module Sig_analyser = Odoc_sig.Analyser (Odoc_comments.Basic_info_retriever) and we don't want to take care of this. Besises, these differences only concern code generation (i believe).*) let process_error exn = - let report ppf = function - | Sys_error msg -> - Location.print_error_cur_file ppf; - fprintf ppf "I/O error: %s" msg - | Warnings.Errors (n) -> - Location.print_error_cur_file ppf; - fprintf ppf "Some fatal warnings were triggered (%d occurrences)" n - | x -> - match Location.error_of_exn x with - | Some err -> Location.report_error ppf err - | None -> - fprintf ppf "@]"; - fprintf ppf - "Compilation error(%s). Use the OCaml compiler to get more details." - (Printexc.to_string x) + let report ppf x = + match Location.error_of_exn x with + | Some err -> Location.report_error ppf err + | None -> + fprintf ppf "@]"; + fprintf ppf + "Compilation error(%s). Use the OCaml compiler to get more details." + (Printexc.to_string x) in Format.fprintf Format.err_formatter "@[%a@]@." report exn diff --git a/parsing/location.ml b/parsing/location.ml index 63c2d0422..579c1dbef 100644 --- a/parsing/location.ml +++ b/parsing/location.ml @@ -347,3 +347,16 @@ let error_of_printer loc print x = let error_of_printer_file print x = error_of_printer (in_file !input_name) print x + +let () = + register_error_of_exn + (function + | Sys_error msg -> + Some (errorf ~loc:(in_file !input_name) "Error: I/O error: %s" msg) + | Warnings.Errors n -> + Some + (errorf ~loc:(in_file !input_name) + "Error: Some fatal warnings were triggered (%d occurrences)" n) + | _ -> + None + ) |