diff options
| -rw-r--r-- | asmcomp/asmgen.ml | 7 | ||||
| -rw-r--r-- | asmcomp/asmlibrarian.ml | 7 | ||||
| -rw-r--r-- | asmcomp/asmlink.ml | 7 | ||||
| -rw-r--r-- | asmcomp/asmpackager.ml | 7 | ||||
| -rw-r--r-- | asmcomp/compilenv.ml | 7 | ||||
| -rw-r--r-- | driver/errors.ml | 3 | ||||
| -rw-r--r-- | driver/opterrors.ml | 33 | ||||
| -rw-r--r-- | driver/optmain.ml | 4 | ||||
| -rw-r--r-- | toplevel/opttoploop.ml | 4 | ||||
| -rw-r--r-- | toplevel/opttopmain.ml | 2 |
10 files changed, 46 insertions, 35 deletions
diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml index 40f7dafbd..34283875c 100644 --- a/asmcomp/asmgen.ml +++ b/asmcomp/asmgen.ml @@ -140,3 +140,10 @@ let report_error ppf = function | Assembler_error file -> fprintf ppf "Assembler error, input left in file %a" Location.print_filename file + +let () = + Location.register_error_of_exn + (function + | Error err -> Some (Location.error_of_printer_file report_error err) + | _ -> None + ) diff --git a/asmcomp/asmlibrarian.ml b/asmcomp/asmlibrarian.ml index 140791f22..968e1de74 100644 --- a/asmcomp/asmlibrarian.ml +++ b/asmcomp/asmlibrarian.ml @@ -69,3 +69,10 @@ let report_error ppf = function fprintf ppf "Cannot find file %s" name | Archiver_error name -> fprintf ppf "Error while creating the library %s" name + +let () = + Location.register_error_of_exn + (function + | Error err -> Some (Location.error_of_printer_file report_error err) + | _ -> None + ) diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index f6a85a94c..30bb13f63 100644 --- a/asmcomp/asmlink.ml +++ b/asmcomp/asmlink.ml @@ -390,3 +390,10 @@ let report_error ppf = function Location.print_filename filename name Location.print_filename filename name + +let () = + Location.register_error_of_exn + (function + | Error err -> Some (Location.error_of_printer_file report_error err) + | _ -> None + ) diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml index 1a4fe9027..a8fcfe789 100644 --- a/asmcomp/asmpackager.ml +++ b/asmcomp/asmpackager.ml @@ -204,3 +204,10 @@ let report_error ppf = function fprintf ppf "Error while assembling %s" file | Linking_error -> fprintf ppf "Error during partial linking" + +let () = + Location.register_error_of_exn + (function + | Error err -> Some (Location.error_of_printer_file report_error err) + | _ -> None + ) diff --git a/asmcomp/compilenv.ml b/asmcomp/compilenv.ml index 280b13127..48d6be7d4 100644 --- a/asmcomp/compilenv.ml +++ b/asmcomp/compilenv.ml @@ -245,3 +245,10 @@ let report_error ppf = function fprintf ppf "%a@ contains the description for unit\ @ %s when %s was expected" Location.print_filename filename name modname + +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 cb1a047ec..bda1a30ac 100644 --- a/driver/errors.ml +++ b/driver/errors.ml @@ -10,4 +10,7 @@ (* *) (***********************************************************************) +(* This module should be removed. We keep it for now, to avoid + breaking external tools depending on it. *) + let report_error = Location.report_exception diff --git a/driver/opterrors.ml b/driver/opterrors.ml index 68279bff6..bda1a30ac 100644 --- a/driver/opterrors.ml +++ b/driver/opterrors.ml @@ -10,34 +10,7 @@ (* *) (***********************************************************************) -(* WARNING: if you change something in this file, you must look at - errors.ml to see if you need to make the same changes there. -*) +(* This module should be removed. We keep it for now, to avoid + breaking external tools depending on it. *) -open Format - -(* Report an error *) - -let report_error ppf exn = - let report ppf = function - | Compilenv.Error code -> - Location.print_error_cur_file ppf; - Compilenv.report_error ppf code - | Asmgen.Error code -> - Location.print_error_cur_file ppf; - Asmgen.report_error ppf code - | Asmlink.Error code -> - Location.print_error_cur_file ppf; - Asmlink.report_error ppf code - | Asmlibrarian.Error code -> - Location.print_error_cur_file ppf; - Asmlibrarian.report_error ppf code - | Asmpackager.Error code -> - Location.print_error_cur_file ppf; - Asmpackager.report_error ppf code - | 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 +let report_error = Location.report_exception diff --git a/driver/optmain.ml b/driver/optmain.ml index 45bdec244..9f973f2b1 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -201,7 +201,7 @@ let main () = end; exit 0 with x -> - Opterrors.report_error ppf x; - exit 2 + Location.report_exception ppf x; + exit 2 let _ = main () diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml index 770ce481c..5bac89781 100644 --- a/toplevel/opttoploop.ml +++ b/toplevel/opttoploop.ml @@ -325,7 +325,7 @@ let use_file ppf name = with | Exit -> false | Sys.Break -> fprintf ppf "Interrupted.@."; false - | x -> Opterrors.report_error ppf x; false) in + | x -> Location.report_exception ppf x; false) in if must_close then close_in ic; success with Not_found -> fprintf ppf "Cannot find file %s.@." name; false @@ -439,7 +439,7 @@ let loop ppf = | End_of_file -> exit 0 | Sys.Break -> fprintf ppf "Interrupted.@."; Btype.backtrack snap | PPerror -> () - | x -> Opterrors.report_error ppf x; Btype.backtrack snap + | x -> Location.report_exception ppf x; Btype.backtrack snap done (* Execute a script *) diff --git a/toplevel/opttopmain.ml b/toplevel/opttopmain.ml index 43141e8c0..3e15c1988 100644 --- a/toplevel/opttopmain.ml +++ b/toplevel/opttopmain.ml @@ -26,7 +26,7 @@ let prepare ppf = !Opttoploop.toplevel_startup_hook (); res with x -> - try Opterrors.report_error ppf x; false + try Location.report_exception ppf x; false with x -> Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x); false |