From c6d5faa79f5530edb8ec19187b1175c007f17d2e Mon Sep 17 00:00:00 2001
From: Etienne Millon <me@emillon.org>
Date: Mon, 6 Aug 2018 08:01:42 +0000
Subject: [PATCH] Use explicit comparison function for Loc.t

Signed-off-by: Etienne Millon <me@emillon.org>
---
 src/dir_contents.ml   |  2 +-
 src/gen_rules.ml      |  2 +-
 src/loc.ml            | 19 +++++++++++++++++++
 src/loc.mli           |  2 ++
 src/report_error.ml   |  7 ++++++-
 src/stdune/option.ml  |  7 +++++++
 src/stdune/option.mli |  2 ++
 src/stdune/string.ml  |  1 +
 src/stdune/string.mli |  1 +
 9 files changed, 40 insertions(+), 3 deletions(-)

diff --git a/src/dir_contents.ml b/src/dir_contents.ml
index 0cb2dee5..7f3d362d 100644
--- a/src/dir_contents.ml
+++ b/src/dir_contents.ml
@@ -274,7 +274,7 @@ let mlds t (doc : Documentation.t) =
   let map = Lazy.force t.mlds in
   match
     List.find_map map ~f:(fun (doc', x) ->
-      Option.some_if (doc.loc = doc'.loc) x)
+      Option.some_if (Loc.equal doc.loc doc'.loc) x)
   with
   | Some x -> x
   | None ->
diff --git a/src/gen_rules.ml b/src/gen_rules.ml
index bd77fcfd..c4b434f5 100644
--- a/src/gen_rules.ml
+++ b/src/gen_rules.ml
@@ -697,7 +697,7 @@ module Gen(P : Install_rules.Params) = struct
               Option.bind (Dir_contents.lookup_module dir_contents name)
                 ~f:(fun buildable ->
                   List.find_map cctxs ~f:(fun (loc, cctx) ->
-                    Option.some_if (loc = buildable.loc) cctx)))
+                    Option.some_if (Loc.equal loc buildable.loc) cctx)))
         with
         | None ->
           (* This happens often when passing a [-p ...] option that
diff --git a/src/loc.ml b/src/loc.ml
index 81b0f470..60b9eea1 100644
--- a/src/loc.ml
+++ b/src/loc.ml
@@ -77,3 +77,22 @@ let to_file_colon_line t =
 
 let pp_file_colon_line ppf t =
   Format.pp_print_string ppf (to_file_colon_line t)
+
+let equal_position
+      { Lexing.pos_fname = f_a; pos_lnum = l_a
+      ; pos_bol = b_a; pos_cnum = c_a }
+      { Lexing.pos_fname = f_b; pos_lnum = l_b
+      ; pos_bol = b_b; pos_cnum = c_b }
+      =
+      let open Int.Infix in
+      String.equal f_a f_b
+      && l_a = l_b
+      && b_a = b_b
+      && c_a = c_b
+
+let equal
+      { start = start_a ; stop = stop_a }
+      { start = start_b ; stop = stop_b }
+  =
+  equal_position start_a start_b
+  && equal_position stop_a stop_b
diff --git a/src/loc.mli b/src/loc.mli
index 5bcad0cc..053030ed 100644
--- a/src/loc.mli
+++ b/src/loc.mli
@@ -3,6 +3,8 @@ type t = Usexp.Loc.t =
   ; stop  : Lexing.position
   }
 
+val equal : t -> t -> bool
+
 val sexp_of_t : t -> Usexp.t
 
 val of_lexbuf : Lexing.lexbuf -> t
diff --git a/src/report_error.ml b/src/report_error.ml
index c347549a..7832aa8d 100644
--- a/src/report_error.ml
+++ b/src/report_error.ml
@@ -114,7 +114,12 @@ let report exn =
     let backtrace = Printexc.get_raw_backtrace () in
     let ppf = err_ppf in
     let p = report_with_backtrace exn in
-    let loc = if p.loc = Some Loc.none then None else p.loc in
+    let loc =
+      if Option.equal Loc.equal p.loc (Some Loc.none) then
+        None
+      else
+        p.loc
+    in
     Option.iter loc ~f:(fun loc -> Loc.print ppf loc);
     p.pp ppf;
     Format.pp_print_flush ppf ();
diff --git a/src/stdune/option.ml b/src/stdune/option.ml
index 6280f4d9..abbaa621 100644
--- a/src/stdune/option.ml
+++ b/src/stdune/option.ml
@@ -52,3 +52,10 @@ let both x y =
 let to_list = function
   | None -> []
   | Some x -> [x]
+
+let equal eq x y =
+  match (x, y) with
+  | None, None -> true
+  | Some _, None -> false
+  | None, Some _ -> false
+  | Some sx, Some sy -> eq sx sy
diff --git a/src/stdune/option.mli b/src/stdune/option.mli
index 30385045..720386f5 100644
--- a/src/stdune/option.mli
+++ b/src/stdune/option.mli
@@ -26,3 +26,5 @@ val is_none : _ t -> bool
 val both : 'a t -> 'b t -> ('a * 'b) t
 
 val to_list : 'a t -> 'a list
+
+val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
diff --git a/src/stdune/string.ml b/src/stdune/string.ml
index e75da57f..00c926e0 100644
--- a/src/stdune/string.ml
+++ b/src/stdune/string.ml
@@ -7,6 +7,7 @@ include struct
   let uncapitalize_ascii = String.uncapitalize
   let uppercase_ascii    = String.uppercase
   let lowercase_ascii    = String.lowercase
+  let equal (a:string) b = Pervasives.(=) a b
 end
 
 include StringLabels
diff --git a/src/stdune/string.mli b/src/stdune/string.mli
index a21c574f..3a0844b1 100644
--- a/src/stdune/string.mli
+++ b/src/stdune/string.mli
@@ -1,5 +1,6 @@
 include module type of struct include StringLabels end
 
+val equal : t -> t -> bool
 val compare : t -> t -> Ordering.t
 
 val break : t -> pos:int -> t * t