Move Code_error to Stdune.Exn
This exception is useful outside of jbuilder
This commit is contained in:
parent
98b2ea795c
commit
24041593da
|
@ -852,7 +852,7 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to =
|
|||
(match Path.kind path with
|
||||
| External _ ->
|
||||
(* Internally we make sure never to do that, and [Unexpanded.*expand] check that *)
|
||||
Sexp.code_error
|
||||
Exn.code_error
|
||||
"(mkdir ...) is not supported for paths outside of the workspace"
|
||||
[ "mkdir", Path.sexp_of_t path ]
|
||||
| Local path ->
|
||||
|
|
|
@ -208,7 +208,7 @@ module Rule = struct
|
|||
if Path.parent path <> dir then
|
||||
match loc with
|
||||
| None ->
|
||||
Sexp.code_error "rule has targets in different directories"
|
||||
Exn.code_error "rule has targets in different directories"
|
||||
[ "targets", Sexp.To_sexp.list Path.sexp_of_t
|
||||
(List.map targets ~f:Target.path)
|
||||
]
|
||||
|
|
|
@ -1448,7 +1448,7 @@ let get_collector t ~dir =
|
|||
collector
|
||||
| Failed_to_load -> raise Already_reported
|
||||
| Loaded _ | Forward _ ->
|
||||
Sexp.code_error
|
||||
Exn.code_error
|
||||
(if Path.is_in_source_tree dir then
|
||||
"Build_system.get_collector called on source directory"
|
||||
else if dir = Path.build_dir then
|
||||
|
@ -1477,7 +1477,7 @@ let prefix_rules t prefix ~f =
|
|||
begin match Build_interpret.targets prefix with
|
||||
| [] -> ()
|
||||
| targets ->
|
||||
Sexp.code_error "Build_system.prefix_rules' prefix contains targets"
|
||||
Exn.code_error "Build_system.prefix_rules' prefix contains targets"
|
||||
["targets", Path.Set.sexp_of_t (Build_interpret.Target.paths targets)]
|
||||
end;
|
||||
let prefix =
|
||||
|
|
|
@ -41,7 +41,7 @@ let of_unix arr =
|
|||
|> List.map ~f:(fun s ->
|
||||
match String.lsplit2 s ~on:'=' with
|
||||
| None ->
|
||||
Sexp.code_error "Env.of_unix: entry without '=' found in the environ"
|
||||
Exn.code_error "Env.of_unix: entry without '=' found in the environ"
|
||||
["var", Sexp.To_sexp.string s]
|
||||
| Some (k, v) -> (k, v))
|
||||
|> Map.of_list_multi
|
||||
|
|
|
@ -1,5 +1,4 @@
|
|||
exception Fatal_error of string
|
||||
exception Code_error of string
|
||||
exception Already_reported
|
||||
|
||||
let err_buf = Buffer.create 128
|
||||
|
@ -14,7 +13,7 @@ let kerrf fmt ~f =
|
|||
err_ppf fmt
|
||||
|
||||
let code_errorf fmt =
|
||||
kerrf fmt ~f:(fun s -> raise (Code_error s))
|
||||
kerrf fmt ~f:(fun s -> Stdune.Exn.code_error s [])
|
||||
|
||||
let die fmt =
|
||||
kerrf fmt ~f:(fun s -> raise (Fatal_error s))
|
||||
|
|
|
@ -12,11 +12,6 @@
|
|||
(** A fatal error, that should be reported to the user in a nice way *)
|
||||
exception Fatal_error of string
|
||||
|
||||
(* CR-soon diml: replace the [string] argument by [Usexp.t] *)
|
||||
(** An programming error in the code of jbuilder, that should be reported upstream. The
|
||||
error message shouldn't try to be developper friendly rather than user friendly. *)
|
||||
exception Code_error of string
|
||||
|
||||
(* CR-soon diml: we won't need this once we can generate rules dynamically *)
|
||||
(** Raised for errors that have already been reported to the user and shouldn't be
|
||||
reported again. This might happen when trying to build a dependency that has already
|
||||
|
|
|
@ -596,7 +596,7 @@ module Sub_system_info = struct
|
|||
let () =
|
||||
match Sub_system_name.Table.get all name with
|
||||
| Some _ ->
|
||||
Sexp.code_error "Sub_system_info.register: already registered"
|
||||
Exn.code_error "Sub_system_info.register: already registered"
|
||||
[ "name", Sexp.To_sexp.string (Sub_system_name.to_string name) ];
|
||||
| None ->
|
||||
Sub_system_name.Table.set all ~key:name ~data:(Some (module M : S));
|
||||
|
|
|
@ -600,7 +600,7 @@ let already_in_table (info : Info.t) name x =
|
|||
List [Sexp.unsafe_atom_of_string "Hidden";
|
||||
Path.sexp_of_t path; Sexp.atom reason]
|
||||
in
|
||||
Sexp.code_error
|
||||
Exn.code_error
|
||||
"Lib_db.DB: resolver returned name that's already in the table"
|
||||
[ "name" , Sexp.atom name
|
||||
; "returned_lib" , to_sexp (info.src_dir, name)
|
||||
|
@ -1061,7 +1061,7 @@ module DB = struct
|
|||
let get_compile_info t ?(allow_overlaps=false) name =
|
||||
match find_even_when_hidden t name with
|
||||
| None ->
|
||||
Sexp.code_error "Lib.DB.get_compile_info got library that doesn't exist"
|
||||
Exn.code_error "Lib.DB.get_compile_info got library that doesn't exist"
|
||||
[ "name", Sexp.To_sexp.string name ]
|
||||
| Some lib ->
|
||||
let t = Option.some_if (not allow_overlaps) t in
|
||||
|
|
|
@ -13,7 +13,7 @@ module Dep_graph = struct
|
|||
match Module.Name.Map.find t.per_module m.name with
|
||||
| Some x -> x
|
||||
| None ->
|
||||
Sexp.code_error "Ocamldep.Dep_graph.deps_of"
|
||||
Exn.code_error "Ocamldep.Dep_graph.deps_of"
|
||||
[ "dir", Path.sexp_of_t t.dir
|
||||
; "modules", Sexp.To_sexp.(list Module.Name.t)
|
||||
(Module.Name.Map.keys t.per_module)
|
||||
|
|
|
@ -235,7 +235,7 @@ module Unexpanded = struct
|
|||
match String.Map.find files_contents fn with
|
||||
| Some x -> x
|
||||
| None ->
|
||||
Sexp.code_error
|
||||
Exn.code_error
|
||||
"Ordered_set_lang.Unexpanded.expand"
|
||||
[ "included-file", Quoted_string fn
|
||||
; "files", Sexp.To_sexp.(list string)
|
||||
|
|
12
src/path.ml
12
src/path.ml
|
@ -290,7 +290,7 @@ let reach t ~from =
|
|||
match is_local t, is_local from with
|
||||
| false, _ -> t
|
||||
| true, false ->
|
||||
Sexp.code_error "Path.reach called with invalid combination"
|
||||
Exn.code_error "Path.reach called with invalid combination"
|
||||
[ "t" , sexp_of_t t
|
||||
; "from", sexp_of_t from
|
||||
]
|
||||
|
@ -300,7 +300,7 @@ let reach_for_running t ~from =
|
|||
match is_local t, is_local from with
|
||||
| false, _ -> t
|
||||
| true, false ->
|
||||
Sexp.code_error "Path.reach_for_running called with invalid combination"
|
||||
Exn.code_error "Path.reach_for_running called with invalid combination"
|
||||
[ "t" , sexp_of_t t
|
||||
; "from", sexp_of_t from
|
||||
]
|
||||
|
@ -325,7 +325,7 @@ let is_descendant t ~of_ =
|
|||
|
||||
let append a b =
|
||||
if not (is_local b) then
|
||||
Sexp.code_error "Path.append called with non-local second path"
|
||||
Exn.code_error "Path.append called with non-local second path"
|
||||
[ "a", sexp_of_t a
|
||||
; "b", sexp_of_t b
|
||||
];
|
||||
|
@ -391,7 +391,7 @@ let drop_build_context t =
|
|||
|
||||
let drop_build_context_exn t =
|
||||
match extract_build_context t with
|
||||
| None -> Sexp.code_error "Path.drop_build_context_exn" [ "t", sexp_of_t t ]
|
||||
| None -> Exn.code_error "Path.drop_build_context_exn" [ "t", sexp_of_t t ]
|
||||
| Some (_, t) -> t
|
||||
|
||||
let drop_optional_build_context t =
|
||||
|
@ -424,7 +424,7 @@ let explode_exn t =
|
|||
else if is_local t then
|
||||
String.split t ~on:'/'
|
||||
else
|
||||
Sexp.code_error "Path.explode_exn"
|
||||
Exn.code_error "Path.explode_exn"
|
||||
["path", Sexp.atom_or_quoted_string t]
|
||||
|
||||
let exists t = Sys.file_exists (to_string t)
|
||||
|
@ -456,7 +456,7 @@ let extend_basename t ~suffix = t ^ suffix
|
|||
|
||||
let insert_after_build_dir_exn =
|
||||
let error a b =
|
||||
Sexp.code_error
|
||||
Exn.code_error
|
||||
"Path.insert_after_build_dir_exn"
|
||||
[ "path" , Sexp.unsafe_atom_of_string a
|
||||
; "insert", Sexp.unsafe_atom_of_string b
|
||||
|
|
|
@ -49,14 +49,14 @@ let report_with_backtrace exn =
|
|||
else
|
||||
Format.fprintf ppf "%s\n" (String.capitalize msg)
|
||||
}
|
||||
| Code_error msg ->
|
||||
| Stdune.Exn.Code_error sexp ->
|
||||
{ p with
|
||||
backtrace = true
|
||||
; pp = fun ppf ->
|
||||
Format.fprintf ppf "@{<error>Internal error, please report upstream \
|
||||
including the contents of _build/log.@}\n\
|
||||
Description: %s\n"
|
||||
msg
|
||||
Description: %a\n"
|
||||
Usexp.pp sexp
|
||||
}
|
||||
| Unix.Unix_error (err, func, fname) ->
|
||||
{ p with pp = fun ppf ->
|
||||
|
|
|
@ -27,7 +27,7 @@ module DB = struct
|
|||
| Some scope -> scope
|
||||
| None ->
|
||||
if Path.is_root d || not (Path.is_local d) then
|
||||
Sexp.code_error "Scope.DB.find_by_dir got an invalid path"
|
||||
Exn.code_error "Scope.DB.find_by_dir got an invalid path"
|
||||
[ "dir" , Path.sexp_of_t dir
|
||||
; "context", Sexp.To_sexp.string t.context
|
||||
];
|
||||
|
@ -41,7 +41,7 @@ module DB = struct
|
|||
match Scope_name_map.find t.by_name name with
|
||||
| Some x -> x
|
||||
| None ->
|
||||
Sexp.code_error "Scope.DB.find_by_name"
|
||||
Exn.code_error "Scope.DB.find_by_name"
|
||||
[ "name" , Sexp.To_sexp.(option string) name
|
||||
; "context", Sexp.To_sexp.string t.context
|
||||
; "names",
|
||||
|
@ -60,7 +60,7 @@ module DB = struct
|
|||
Sexp.To_sexp.(pair (option string) Path.sexp_of_t)
|
||||
(scope.name, scope.root)
|
||||
in
|
||||
Sexp.code_error "Scope.DB.create got two scopes with the same name"
|
||||
Exn.code_error "Scope.DB.create got two scopes with the same name"
|
||||
[ "scope1", to_sexp scope1
|
||||
; "scope2", to_sexp scope2
|
||||
]
|
||||
|
|
|
@ -3,12 +3,6 @@ open Import
|
|||
include (Usexp : module type of struct include Usexp end
|
||||
with module Loc := Usexp.Loc)
|
||||
|
||||
let code_error message vars =
|
||||
code_errorf "%a" pp
|
||||
(List (Usexp.atom_or_quoted_string message
|
||||
:: List.map vars ~f:(fun (name, value) ->
|
||||
List [Usexp.atom_or_quoted_string name; value])))
|
||||
|
||||
let buf_len = 65_536
|
||||
|
||||
let load ~fname ~mode =
|
||||
|
|
|
@ -2,8 +2,6 @@ open Import
|
|||
|
||||
include module type of struct include Usexp end with module Loc := Usexp.Loc
|
||||
|
||||
val code_error : string -> (string * t) list -> _
|
||||
|
||||
val load : fname:string -> mode:'a Parser.Mode.t -> 'a
|
||||
val load_many_as_one : fname:string -> Ast.t
|
||||
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
type t = exn
|
||||
|
||||
exception Code_error of Usexp.t
|
||||
|
||||
external raise : exn -> _ = "%raise"
|
||||
external raise_notrace : exn -> _ = "%raise_notrace"
|
||||
external reraise : exn -> _ = "%reraise"
|
||||
|
@ -11,6 +13,13 @@ let protectx x ~f ~finally =
|
|||
|
||||
let protect ~f ~finally = protectx () ~f ~finally
|
||||
|
||||
let code_error message vars =
|
||||
Code_error
|
||||
(Usexp.List (Usexp.atom_or_quoted_string message
|
||||
:: List.map vars ~f:(fun (name, value) ->
|
||||
Usexp.List [Usexp.atom_or_quoted_string name; value])))
|
||||
|> raise
|
||||
|
||||
include
|
||||
((struct
|
||||
[@@@warning "-32-3"]
|
||||
|
|
|
@ -1,5 +1,11 @@
|
|||
(** Exceptions *)
|
||||
|
||||
(** An programming error, that should be reported upstream. The error message
|
||||
shouldn't try to be developer friendly rather than user friendly. *)
|
||||
exception Code_error of Usexp.t
|
||||
|
||||
val code_error : string -> (string * Usexp.t) list -> _
|
||||
|
||||
type t = exn
|
||||
|
||||
external raise : exn -> _ = "%raise"
|
||||
|
|
|
@ -2,4 +2,4 @@
|
|||
((name stdune)
|
||||
(public_name jbuilder.stdune)
|
||||
(synopsis "[Internal] Standard library of Dune")
|
||||
(libraries (caml unix))))
|
||||
(libraries (caml unix usexp))))
|
||||
|
|
|
@ -26,14 +26,14 @@ module Versioned_parser = struct
|
|||
|
||||
let make l =
|
||||
if List.is_empty l then
|
||||
Sexp.code_error "Syntax.Versioned_parser.make got empty list" [];
|
||||
Exn.code_error "Syntax.Versioned_parser.make got empty list" [];
|
||||
match
|
||||
List.map l ~f:(fun ((major, minor), p) -> (major, (minor, p)))
|
||||
|> Int_map.of_list
|
||||
with
|
||||
| Ok x -> x
|
||||
| Error _ ->
|
||||
Sexp.code_error
|
||||
Exn.code_error
|
||||
"Syntax.Versioned_parser.make"
|
||||
[ "versions", Sexp.To_sexp.list Version.sexp_of_t (List.map l ~f:fst) ]
|
||||
|
||||
|
|
Loading…
Reference in New Issue