Avoid catching wildcard exceptions when calling Findlib.find
But to avoid making the catch statements verbose, move all findlib exceptions to a variant.
This commit is contained in:
parent
c066efd196
commit
27e31a3196
|
@ -248,6 +248,21 @@ module Pkg_step1 = struct
|
|||
}
|
||||
end
|
||||
|
||||
module External_dep_conflicts_with_local_lib = struct
|
||||
type t =
|
||||
{ package : string
|
||||
; required_by : string
|
||||
; required_locally_in : Path.t
|
||||
; defined_locally_in : Path.t
|
||||
}
|
||||
end
|
||||
|
||||
type error =
|
||||
| Package_not_available of Package_not_available.t
|
||||
| External_dep_conflicts_with_local_lib of External_dep_conflicts_with_local_lib.t
|
||||
|
||||
exception Findlib of error
|
||||
|
||||
let parse_package t ~name ~parent_dir ~vars ~required_by =
|
||||
let pkg_dir = Vars.get vars "directory" [] in
|
||||
let dir =
|
||||
|
@ -478,18 +493,16 @@ let load_meta t ~fq_name ~required_by =
|
|||
Hashtbl.add t.packages ~key:pkg.package.name ~data:status
|
||||
)
|
||||
|
||||
exception Package_not_available of Package_not_available.t
|
||||
|
||||
let find_exn t ~required_by name =
|
||||
match Hashtbl.find t.packages name with
|
||||
| Some (Present x) -> x
|
||||
| Some (Not_available na) -> raise (Package_not_available na)
|
||||
| Some (Not_available na) -> raise (Findlib (Package_not_available na))
|
||||
| None ->
|
||||
load_meta t ~fq_name:name ~required_by;
|
||||
match Hashtbl.find t.packages name with
|
||||
| Some (Present x) -> x
|
||||
| Some (Not_available pnf) ->
|
||||
raise (Package_not_available pnf)
|
||||
raise (Findlib (Package_not_available pnf))
|
||||
| None ->
|
||||
let na : Package_not_available.t =
|
||||
{ package = name
|
||||
|
@ -498,40 +511,29 @@ let find_exn t ~required_by name =
|
|||
}
|
||||
in
|
||||
Hashtbl.add t.packages ~key:name ~data:(Not_available na);
|
||||
raise (Package_not_available na)
|
||||
raise (Findlib (Package_not_available na))
|
||||
|
||||
let find t ~required_by name =
|
||||
match find_exn t ~required_by name with
|
||||
| exception (Package_not_available _) -> None
|
||||
| exception (Findlib (Package_not_available _)) -> None
|
||||
| x -> Some x
|
||||
|
||||
let available t ~required_by name =
|
||||
match find_exn t name ~required_by with
|
||||
| (_ : package) -> true
|
||||
| exception (Package_not_available _) -> false
|
||||
|
||||
module External_dep_conflicts_with_local_lib = struct
|
||||
type t =
|
||||
{ package : string
|
||||
; required_by : string
|
||||
; required_locally_in : Path.t
|
||||
; defined_locally_in : Path.t
|
||||
}
|
||||
end
|
||||
|
||||
exception External_dep_conflicts_with_local_lib of External_dep_conflicts_with_local_lib.t
|
||||
| exception (Findlib (Package_not_available _)) -> false
|
||||
|
||||
let check_deps_consistency ~required_by ~local_public_libs pkg requires =
|
||||
List.iter requires ~f:(fun pkg' ->
|
||||
match String_map.find pkg'.name local_public_libs with
|
||||
| None -> ()
|
||||
| Some path ->
|
||||
raise (External_dep_conflicts_with_local_lib
|
||||
{ package = pkg'.name
|
||||
; required_by = pkg.name
|
||||
; required_locally_in = required_by
|
||||
; defined_locally_in = path
|
||||
}))
|
||||
raise (Findlib (External_dep_conflicts_with_local_lib
|
||||
{ package = pkg'.name
|
||||
; required_by = pkg.name
|
||||
; required_locally_in = required_by
|
||||
; defined_locally_in = path
|
||||
})))
|
||||
|
||||
let closure ~required_by ~local_public_libs pkgs =
|
||||
remove_dups_preserve_order
|
||||
|
|
|
@ -22,8 +22,6 @@ module Package_not_available : sig
|
|||
val explain : Format.formatter -> reason -> unit
|
||||
end
|
||||
|
||||
exception Package_not_available of Package_not_available.t
|
||||
|
||||
module External_dep_conflicts_with_local_lib : sig
|
||||
type t =
|
||||
{ package : string
|
||||
|
@ -33,7 +31,11 @@ module External_dep_conflicts_with_local_lib : sig
|
|||
}
|
||||
end
|
||||
|
||||
exception External_dep_conflicts_with_local_lib of External_dep_conflicts_with_local_lib.t
|
||||
type error =
|
||||
| Package_not_available of Package_not_available.t
|
||||
| External_dep_conflicts_with_local_lib of External_dep_conflicts_with_local_lib.t
|
||||
|
||||
exception Findlib of error
|
||||
|
||||
(** Findlib database *)
|
||||
type t
|
||||
|
|
|
@ -45,7 +45,7 @@ let find_exn t ~from name =
|
|||
|
||||
let find t ~from name =
|
||||
match find_exn t ~from name with
|
||||
| exception _ -> None
|
||||
| exception (Findlib.Findlib _) -> None
|
||||
| x -> Some x
|
||||
|
||||
let find_internal t ~from name =
|
||||
|
@ -165,7 +165,7 @@ let interpret_lib_dep t ~dir lib_dep =
|
|||
List.map (String_set.elements required) ~f:(find_exn t ~from:dir)
|
||||
with
|
||||
| l -> Some l
|
||||
| exception _ -> None)
|
||||
| exception (Findlib.Findlib _) -> None)
|
||||
with
|
||||
| Some l -> Inl l
|
||||
| None ->
|
||||
|
|
|
@ -113,7 +113,7 @@ let report_error ?(map_fname=fun x->x) ppf exn ~backtrace =
|
|||
| Fatal_error msg ->
|
||||
Format.fprintf ppf "%s\n" (String.capitalize_ascii msg);
|
||||
false
|
||||
| Findlib.Package_not_available { package; required_by; reason } ->
|
||||
| Findlib.Findlib (Findlib.Package_not_available { package; required_by; reason }) ->
|
||||
Format.fprintf ppf
|
||||
"@{<error>Error@}: External library %S %s.\n" package
|
||||
(match reason with
|
||||
|
@ -142,8 +142,8 @@ let report_error ?(map_fname=fun x->x) ppf exn ~backtrace =
|
|||
(List.map !Clflags.external_lib_deps_hint ~f:quote_for_shell
|
||||
|> String.concat ~sep:" ");
|
||||
false
|
||||
| Findlib.External_dep_conflicts_with_local_lib
|
||||
{ package; required_by; required_locally_in; defined_locally_in } ->
|
||||
| Findlib.Findlib (Findlib.External_dep_conflicts_with_local_lib {
|
||||
package; required_by; required_locally_in; defined_locally_in }) ->
|
||||
Format.fprintf ppf
|
||||
"@{<error>Error@}: Conflict between internal and external version of library %S:\n\
|
||||
- it is defined locally in %s\n\
|
||||
|
|
Loading…
Reference in New Issue