From baa258ac91df8a80209b322e8d42c5deb2ada536 Mon Sep 17 00:00:00 2001
From: Chimrod <>
Date: Fri, 15 Mar 2024 10:45:12 +0100
Subject: New test for duplicates evalutations in the code

---
 lib/syntax/report.ml | 30 +++++++++++++++++++++---------
 1 file changed, 21 insertions(+), 9 deletions(-)

(limited to 'lib/syntax/report.ml')

diff --git a/lib/syntax/report.ml b/lib/syntax/report.ml
index 19a9104..0c839fe 100644
--- a/lib/syntax/report.ml
+++ b/lib/syntax/report.ml
@@ -28,22 +28,34 @@ let pp_pos : Format.formatter -> pos -> unit =
     Format.fprintf f "Lines %d-%d" start_line end_line
   else Format.fprintf f "Line %d %d:%d" start_line start_c end_c
 
+let pp_line : Format.formatter -> pos -> unit =
+ fun f (start_pos, end_pos) ->
+  (* Only care about the first line *)
+  ignore end_pos;
+  let start_line = start_pos.Lexing.pos_lnum in
+  Format.fprintf f "%d" start_line
+
 type t = { level : level; loc : pos; message : string }
 [@@deriving show { with_path = false }]
 
+(** Compare two positions *)
+let compare_pos : pos -> pos -> int =
+ fun (pos1_start, pos1_end) (pos2_start, pos2_end) ->
+  (* first compare the position *)
+  match compare pos1_start.pos_cnum pos2_start.pos_cnum with
+  | 0 ->
+      (* Then the ending position *)
+      compare pos1_end.pos_cnum pos2_end.pos_cnum
+  | other -> other
+
 let compare : t -> t -> int =
  fun t1 t2 ->
   (* first compare the position *)
-  let pos1_start, pos1_end = t1.loc and pos2_start, pos2_end = t2.loc in
-  match compare pos1_start.pos_cnum pos2_start.pos_cnum with
+  match compare_pos t1.loc t2.loc with
   | 0 -> (
-      (* Then the ending position *)
-      match compare pos1_end.pos_cnum pos2_end.pos_cnum with
-      | 0 -> (
-          (* And the level *)
-          match compare (level_to_enum t1.level) (level_to_enum t2.level) with
-          | 0 -> String.compare t1.message t2.message
-          | other -> other)
+      (* And the level *)
+      match compare (level_to_enum t1.level) (level_to_enum t2.level) with
+      | 0 -> String.compare t1.message t2.message
       | other -> other)
   | other -> other
 
-- 
cgit v1.2.3