Use explicit comparison for path functions
Signed-off-by: Etienne Millon <me@emillon.org>
This commit is contained in:
parent
da1f65bc56
commit
35ea17ebc4
|
@ -630,7 +630,7 @@ let target_hint (setup : Main.setup) path =
|
||||||
(* Only suggest hints for the basename, otherwise it's slow when there are lots of
|
(* Only suggest hints for the basename, otherwise it's slow when there are lots of
|
||||||
files *)
|
files *)
|
||||||
List.filter_map candidates ~f:(fun path ->
|
List.filter_map candidates ~f:(fun path ->
|
||||||
if Path.parent_exn path = sub_dir then
|
if Path.equal (Path.parent_exn path) sub_dir then
|
||||||
Some (Path.to_string path)
|
Some (Path.to_string path)
|
||||||
else
|
else
|
||||||
None)
|
None)
|
||||||
|
|
|
@ -431,7 +431,7 @@ let get_dir_status t ~dir =
|
||||||
Path.Table.find_or_add t.dirs dir ~f:(fun _ ->
|
Path.Table.find_or_add t.dirs dir ~f:(fun _ ->
|
||||||
if Path.is_in_source_tree dir then
|
if Path.is_in_source_tree dir then
|
||||||
Dir_status.Loaded (File_tree.files_of t.file_tree dir)
|
Dir_status.Loaded (File_tree.files_of t.file_tree dir)
|
||||||
else if dir = Path.build_dir then
|
else if Path.equal dir Path.build_dir then
|
||||||
(* Not allowed to look here *)
|
(* Not allowed to look here *)
|
||||||
Dir_status.Loaded Path.Set.empty
|
Dir_status.Loaded Path.Set.empty
|
||||||
else if not (Path.is_managed dir) then
|
else if not (Path.is_managed dir) then
|
||||||
|
@ -901,7 +901,7 @@ and load_dir_and_get_targets t ~dir =
|
||||||
| [] -> assert false
|
| [] -> assert false
|
||||||
| x :: l ->
|
| x :: l ->
|
||||||
t.load_dir_stack <- l;
|
t.load_dir_stack <- l;
|
||||||
assert (x = dir)));
|
assert (Path.equal x dir)));
|
||||||
Path.Table.replace t.dirs ~key:dir ~data:Failed_to_load;
|
Path.Table.replace t.dirs ~key:dir ~data:Failed_to_load;
|
||||||
reraise exn
|
reraise exn
|
||||||
|
|
||||||
|
@ -1095,7 +1095,7 @@ The following targets are not:
|
||||||
| [] -> assert false
|
| [] -> assert false
|
||||||
| x :: l ->
|
| x :: l ->
|
||||||
t.load_dir_stack <- l;
|
t.load_dir_stack <- l;
|
||||||
assert (x = dir));
|
assert (Path.equal x dir));
|
||||||
|
|
||||||
(* Compile the rules and cleanup stale artifacts *)
|
(* Compile the rules and cleanup stale artifacts *)
|
||||||
List.iter rules ~f:(compile_rule t ~copy_source:false);
|
List.iter rules ~f:(compile_rule t ~copy_source:false);
|
||||||
|
@ -1528,7 +1528,7 @@ let get_collector t ~dir =
|
||||||
Exn.code_error
|
Exn.code_error
|
||||||
(if Path.is_in_source_tree dir then
|
(if Path.is_in_source_tree dir then
|
||||||
"Build_system.get_collector called on source directory"
|
"Build_system.get_collector called on source directory"
|
||||||
else if dir = Path.build_dir then
|
else if Path.equal dir Path.build_dir then
|
||||||
"Build_system.get_collector called on build_dir"
|
"Build_system.get_collector called on build_dir"
|
||||||
else if not (Path.is_managed dir) then
|
else if not (Path.is_managed dir) then
|
||||||
"Build_system.get_collector called on external directory"
|
"Build_system.get_collector called on external directory"
|
||||||
|
|
|
@ -549,7 +549,7 @@ module Dir_status = struct
|
||||||
let project_root = Path.of_local (File_tree.Dir.project ft_dir).root in
|
let project_root = Path.of_local (File_tree.Dir.project ft_dir).root in
|
||||||
match Super_context.stanzas_in sctx ~dir with
|
match Super_context.stanzas_in sctx ~dir with
|
||||||
| None ->
|
| None ->
|
||||||
if dir = project_root ||
|
if Path.equal dir project_root ||
|
||||||
is_standalone (get sctx ~dir:(Path.parent_exn dir)) then
|
is_standalone (get sctx ~dir:(Path.parent_exn dir)) then
|
||||||
Standalone (Some (ft_dir, None))
|
Standalone (Some (ft_dir, None))
|
||||||
else
|
else
|
||||||
|
|
|
@ -1846,7 +1846,7 @@ module Stanzas = struct
|
||||||
if not (Path.exists current_file) then
|
if not (Path.exists current_file) then
|
||||||
Loc.fail loc "File %s doesn't exist."
|
Loc.fail loc "File %s doesn't exist."
|
||||||
(Path.to_string_maybe_quoted current_file);
|
(Path.to_string_maybe_quoted current_file);
|
||||||
if List.exists include_stack ~f:(fun (_, f) -> f = current_file) then
|
if List.exists include_stack ~f:(fun (_, f) -> Path.equal f current_file) then
|
||||||
raise (Include_loop (current_file, include_stack));
|
raise (Include_loop (current_file, include_stack));
|
||||||
let sexps = Io.Sexp.load ~lexer current_file ~mode:Many in
|
let sexps = Io.Sexp.load ~lexer current_file ~mode:Many in
|
||||||
parse stanza_parser sexps ~lexer ~current_file ~include_stack
|
parse stanza_parser sexps ~lexer ~current_file ~include_stack
|
||||||
|
|
|
@ -242,7 +242,7 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
|
||||||
~f:(fun dir acc ->
|
~f:(fun dir acc ->
|
||||||
let p = File_tree.Dir.project dir in
|
let p = File_tree.Dir.project dir in
|
||||||
match Path.kind (File_tree.Dir.path dir) with
|
match Path.kind (File_tree.Dir.path dir) with
|
||||||
| Local d when d = p.root -> p :: acc
|
| Local d when Path.Local.equal d p.root -> p :: acc
|
||||||
| _ -> acc)
|
| _ -> acc)
|
||||||
in
|
in
|
||||||
let packages =
|
let packages =
|
||||||
|
|
|
@ -125,7 +125,7 @@ let build_cm cc ~(js_of_ocaml:Jbuild.Js_of_ocaml.t) ~src ~target =
|
||||||
>>>
|
>>>
|
||||||
js_of_ocaml_rule sctx ~dir ~flags:(fun flags -> As flags) ~spec ~target:itarget
|
js_of_ocaml_rule sctx ~dir ~flags:(fun flags -> As flags) ~spec ~target:itarget
|
||||||
]
|
]
|
||||||
@ (if target = itarget then
|
@ (if Path.equal target itarget then
|
||||||
[]
|
[]
|
||||||
else
|
else
|
||||||
[Build.symlink ~src:itarget ~dst:target])
|
[Build.symlink ~src:itarget ~dst:target])
|
||||||
|
|
|
@ -8,7 +8,7 @@ let print ?(skip_trailing_cr=Sys.win32) path1 path2 =
|
||||||
Path.extract_build_context_dir path1,
|
Path.extract_build_context_dir path1,
|
||||||
Path.extract_build_context_dir path2
|
Path.extract_build_context_dir path2
|
||||||
with
|
with
|
||||||
| Some (dir1, f1), Some (dir2, f2) when dir1 = dir2 ->
|
| Some (dir1, f1), Some (dir2, f2) when Path.equal dir1 dir2 ->
|
||||||
(dir1, Path.to_string f1, Path.to_string f2)
|
(dir1, Path.to_string f1, Path.to_string f2)
|
||||||
| _ ->
|
| _ ->
|
||||||
(Path.root, Path.to_string path1, Path.to_string path2)
|
(Path.root, Path.to_string path1, Path.to_string path2)
|
||||||
|
|
|
@ -125,7 +125,7 @@ module Fancy = struct
|
||||||
in
|
in
|
||||||
match stdout_to, stderr_to with
|
match stdout_to, stderr_to with
|
||||||
| (File fn1 | Opened_file { filename = fn1; _ }),
|
| (File fn1 | Opened_file { filename = fn1; _ }),
|
||||||
(File fn2 | Opened_file { filename = fn2; _ }) when fn1 = fn2 ->
|
(File fn2 | Opened_file { filename = fn2; _ }) when Path.equal fn1 fn2 ->
|
||||||
sprintf "%s &> %s" s (Path.to_string fn1)
|
sprintf "%s &> %s" s (Path.to_string fn1)
|
||||||
| _ ->
|
| _ ->
|
||||||
let s =
|
let s =
|
||||||
|
|
|
@ -136,6 +136,7 @@ module Local : sig
|
||||||
val is_root : t -> bool
|
val is_root : t -> bool
|
||||||
val compare : t -> t -> Ordering.t
|
val compare : t -> t -> Ordering.t
|
||||||
val compare_val : t -> t -> Ordering.t
|
val compare_val : t -> t -> Ordering.t
|
||||||
|
val equal : t -> t -> bool
|
||||||
val of_string : ?error_loc:Usexp.Loc.t -> string -> t
|
val of_string : ?error_loc:Usexp.Loc.t -> string -> t
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
val relative : ?error_loc:Usexp.Loc.t -> t -> string -> t
|
val relative : ?error_loc:Usexp.Loc.t -> t -> string -> t
|
||||||
|
@ -172,6 +173,11 @@ end = struct
|
||||||
|
|
||||||
let compare_val x y = String.compare (to_string x) (to_string y)
|
let compare_val x y = String.compare (to_string x) (to_string y)
|
||||||
|
|
||||||
|
let equal x y =
|
||||||
|
match compare x y with
|
||||||
|
| Eq -> true
|
||||||
|
| Gt | Lt -> false
|
||||||
|
|
||||||
let root = make "."
|
let root = make "."
|
||||||
|
|
||||||
let is_root t = t = root
|
let is_root t = t = root
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
module Local : sig
|
module Local : sig
|
||||||
type t
|
type t
|
||||||
val sexp_of_t : t -> Sexp.t
|
val sexp_of_t : t -> Sexp.t
|
||||||
|
val equal : t -> t -> bool
|
||||||
end
|
end
|
||||||
|
|
||||||
(** In the outside world *)
|
(** In the outside world *)
|
||||||
|
@ -31,6 +32,8 @@ val sexp_of_t : t Sexp.To_sexp.t
|
||||||
val compare : t -> t -> Ordering.t
|
val compare : t -> t -> Ordering.t
|
||||||
(** a directory is smaller than its descendants *)
|
(** a directory is smaller than its descendants *)
|
||||||
|
|
||||||
|
val equal : t -> t -> bool
|
||||||
|
|
||||||
module Set : sig
|
module Set : sig
|
||||||
include Set.S with type elt = t
|
include Set.S with type elt = t
|
||||||
val sexp_of_t : t Sexp.To_sexp.t
|
val sexp_of_t : t Sexp.To_sexp.t
|
||||||
|
|
|
@ -638,7 +638,7 @@ let create
|
||||||
List.iter stanzas ~f:(function
|
List.iter stanzas ~f:(function
|
||||||
| Dune_env.T config ->
|
| Dune_env.T config ->
|
||||||
let inherit_from =
|
let inherit_from =
|
||||||
if ctx_dir = Scope.root scope then
|
if Path.equal ctx_dir (Scope.root scope) then
|
||||||
context_env_node
|
context_env_node
|
||||||
else
|
else
|
||||||
lazy (Env.get t ~dir:(Path.parent_exn ctx_dir))
|
lazy (Env.get t ~dir:(Path.parent_exn ctx_dir))
|
||||||
|
@ -811,7 +811,7 @@ module Action = struct
|
||||||
| Some host ->
|
| Some host ->
|
||||||
fun exe ->
|
fun exe ->
|
||||||
match Path.extract_build_context_dir exe with
|
match Path.extract_build_context_dir exe with
|
||||||
| Some (dir, exe) when dir = sctx.context.build_dir ->
|
| Some (dir, exe) when Path.equal dir sctx.context.build_dir ->
|
||||||
Path.append host.context.build_dir exe
|
Path.append host.context.build_dir exe
|
||||||
| _ -> exe
|
| _ -> exe
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue