6 files changed, 265 insertions, 11 deletions

diff --git a/lib/syntax/dup_test.ml b/lib/syntax/dup_test.ml
new file mode 100644
index 0000000..7086a6f
--- /dev/null
+++ b/lib/syntax/dup_test.ml
@@ -0,0 +1,187 @@
+(** This module check for duplicated tests in the source.contents
+
+
+    This in intended to identify the copy/paste errors, where one location
+    check for the same arguments twice or more.
+ *)
+
+open StdLabels
+
+let identifier = "duplicate_test"
+let description = "Check for duplicate tests"
+let is_global = false
+let active = ref true
+
+type context = unit
+
+let initialize = Fun.id
+let finalize () = []
+
+module Expression = Tree.Expression
+
+(** Build a Hashtbl over the expression, ignoring the location in the
+    expression *)
+module Table = Hashtbl.Make (struct
+  type t = Expression.t'
+
+  let equal : t -> t -> bool = Tree.Expression.eq (fun _ _ -> true)
+  let hash : t -> int = Tree.Expression.hash (fun _ -> 0)
+end)
+
+module Instruction = struct
+  type state = {
+    predicates : (Expression.t' * S.pos) list;
+    duplicates : (Expression.t' * S.pos list) list;
+  }
+  (** Keep the list of all the predicates and their position in a block, and
+      the list of all the identified duplicated values. *)
+
+  type t = state
+  type t' = state
+
+  let v : t -> t' = fun t -> t
+  let default = { predicates = []; duplicates = [] }
+
+  (** Label for a loop *)
+  let location : S.pos -> string -> t = fun _ _ -> default
+
+  (** Comment *)
+  let comment : S.pos -> t = fun _ -> default
+
+  (** Raw expression *)
+  let expression : Expression.t' -> t = fun _ -> default
+
+  let check_duplicates :
+      (Expression.t' * S.pos) list -> (Expression.t' * S.pos list) list =
+   fun predicates ->
+    let table = Table.create 5 in
+    let () = List.to_seq predicates |> Table.add_seq table in
+
+    Table.to_seq_keys table
+    |> Seq.group (Tree.Expression.eq (fun _ _ -> true))
+    |> Seq.filter_map (fun keys ->
+           (* Only take the first element for each group, we don’t need to
+              repeat the key *)
+           match Seq.uncons keys with
+           | None -> None
+           | Some (hd, _) -> (
+               match Table.find_all table hd with
+               | [] | _ :: [] -> None
+               | other -> Some (hd, other)))
+    |> List.of_seq
+
+  (** Evaluate a clause. 
+      This function does two things : 
+          - report all errors from the bottom to top 
+          - add the clause in the actual level *)
+  let predicate_of_clause : ?pos:S.pos -> t -> (Expression.t', t) S.clause -> t
+      =
+   fun ?pos t (pos2, predicate, blocks) ->
+    let pos = Option.value ~default:pos2 pos in
+
+    (* Remove the clauses using the function rnd because they repeating the
+       same clause can generate a different result *)
+    let should_discard =
+      Tree.Expression.exists predicate ~f:(function
+        | Tree.Ast.Function (_, T.Rand, _) | Tree.Ast.Function (_, T.Rnd, _) ->
+            true
+        | _ -> false)
+    in
+
+    {
+      predicates =
+        (match should_discard with
+        | false -> (predicate, pos) :: t.predicates
+        | true -> t.predicates);
+      duplicates =
+        List.fold_left blocks ~init:t.duplicates ~f:(fun acc t ->
+            List.rev_append t.duplicates acc);
+    }
+
+  let if_ :
+      S.pos ->
+      (Expression.t', t) S.clause ->
+      elifs:(Expression.t', t) S.clause list ->
+      else_:(S.pos * t list) option ->
+      t =
+   fun pos clause ~elifs ~else_ ->
+    ignore else_;
+    (* Collect all the if clauses from this block, wait for the parent block to
+       check each case for duplicates. *)
+    let init = predicate_of_clause ~pos default clause in
+    let state = List.fold_left elifs ~init ~f:predicate_of_clause in
+    {
+      state with
+      duplicates = check_duplicates state.predicates @ state.duplicates;
+    }
+
+  let act : S.pos -> label:Expression.t' -> t list -> t =
+   fun _pos ~label expressions ->
+    ignore label;
+    (* Collect all the elements reported from bottom to up. *)
+    List.fold_left ~init:default expressions ~f:(fun state ex ->
+        {
+          predicates = [];
+          duplicates = List.rev_append ex.duplicates state.duplicates;
+        })
+
+  let assign :
+      S.pos ->
+      (S.pos, Expression.t') S.variable ->
+      T.assignation_operator ->
+      Expression.t' ->
+      t =
+   fun _ _ _ _ -> default
+
+  let call : S.pos -> T.keywords -> Expression.t' list -> t =
+   fun _ _ _ -> default
+end
+
+module Location = struct
+  type t = (Expression.t' * S.pos list) list
+
+  type context = unit
+  (** No context *)
+
+  (** Check if the given expression is involving the variable ARGS or $ARGS *)
+  let is_args : Expression.t' -> bool = function
+    | Tree.Ast.Ident { name; _ } ->
+        String.equal name "ARGS" || String.equal name "$ARGS"
+    | _ -> false
+
+  let location : context -> S.pos -> Instruction.t' list -> t =
+   fun () _ block ->
+    (* Filter the tests from the top level and only keep them testing ARGS *)
+    let duplicates =
+      List.map block ~f:(fun t ->
+          List.filter_map t.Instruction.predicates ~f:(fun v ->
+              match (Tree.Expression.exists ~f:is_args) (fst v) with
+              | true -> Some v
+              | false -> None))
+      |> List.concat |> Instruction.check_duplicates
+    in
+    List.fold_left ~init:duplicates block ~f:(fun state ex ->
+        List.rev_append ex.Instruction.duplicates state)
+
+  (** Create the report message *)
+  let v' : Expression.t' * S.pos list -> Report.t option =
+   fun (expr, pos) ->
+    ignore expr;
+    match (List.sort ~cmp:Report.compare_pos) pos with
+    | [] -> None
+    | _ :: [] -> None
+    | hd :: tl ->
+        let message =
+          Format.asprintf "This case is duplicated line(s) %a"
+            (Format.pp_print_list
+               ~pp_sep:(fun f () -> Format.pp_print_char f ',')
+               Report.pp_line)
+            tl
+        in
+
+        (* Ignore the first case, and report all the following ones *)
+        Some (Report.warn hd message)
+
+  let v : t -> Report.t list =
+   fun t -> List.filter_map t ~f:v' |> List.sort_uniq ~cmp:Report.compare
+end
diff --git a/lib/syntax/dup_test.mli b/lib/syntax/dup_test.mli
new file mode 100644
index 0000000..38e3a1b
--- /dev/null
+++ b/lib/syntax/dup_test.mli
@@ -0,0 +1 @@
+include S.Analyzer
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
 
diff --git a/lib/syntax/t.ml b/lib/syntax/t.ml
index cb9c7ce..882a375 100644
--- a/lib/syntax/t.ml
+++ b/lib/syntax/t.ml
@@ -7,6 +7,13 @@ type 'a literal = Text of string | Expression of 'a
 let map_litteral : f:('a -> 'b) -> 'a literal -> 'b literal =
  fun ~f -> function Text t -> Text t | Expression e -> Expression (f e)
 
+let eq_literal : eq:('a -> 'a -> bool) -> 'a literal -> 'a literal -> bool =
+ fun ~eq l1 l2 ->
+  match (l1, l2) with
+  | Text s1, Text s2 -> String.equal s1 s2
+  | Expression e1, Expression e2 -> eq e1 e2
+  | _ -> false
+
 type boperator =
   | Eq
   | Neq
diff --git a/lib/syntax/tree.ml b/lib/syntax/tree.ml
index b7d9d15..0074df8 100644
--- a/lib/syntax/tree.ml
+++ b/lib/syntax/tree.ml
@@ -45,10 +45,48 @@ module Ast = struct
 end
 
 (** Default implementation for the expression *)
-module Expression : S.Expression with type t' = S.pos Ast.expression = struct
+module Expression : sig
+  include S.Expression with type t' = S.pos Ast.expression
+
+  val eq : (S.pos -> S.pos -> bool) -> t' -> t' -> bool
+  val hash : (S.pos -> int) -> t' -> int
+  val exists : f:(t' -> bool) -> t' -> bool
+end = struct
   type t = S.pos Ast.expression
   type t' = t
 
+  let eq : (S.pos -> S.pos -> bool) -> t -> t -> bool = Ast.equal_expression
+
+  (* Add a way to filter an expression *)
+  let rec exists : f:(t -> bool) -> t -> bool =
+   fun ~f -> function
+    | BinaryOp (_, _, o1, o2) as op -> f op || exists ~f o1 || exists ~f o2
+    | Op (_, _, expr) as op -> f op || exists ~f expr
+    | Function (_, _, exprs) as fn -> f fn || List.exists exprs ~f:(exists ~f)
+    | Literal (_, litts) as litt ->
+        f litt
+        || List.exists litts ~f:(function
+             | T.Text _ -> false
+             | T.Expression ex -> exists ~f ex)
+    | Ident { index; _ } as ident -> (
+        f ident
+        || match index with None -> false | Some expr -> exists ~f expr)
+    | Integer _ as int -> f int
+
+  let rec hash : (S.pos -> int) -> t -> int =
+   fun f -> function
+    | Integer (pos, v) -> Hashtbl.hash (f pos, v)
+    | Literal (pos, l) ->
+        let litt = List.map ~f:(T.map_litteral ~f:(hash f)) l in
+        Hashtbl.hash (f pos, litt)
+    | Ident { pos; name; index } ->
+        Hashtbl.hash (f pos, name, Option.map (hash f) index)
+    | BinaryOp (pos, op, o1, o2) ->
+        Hashtbl.hash (f pos, op, hash f o1, hash f o2)
+    | Op (pos, op, o1) -> Hashtbl.hash (f pos, op, hash f o1)
+    | Function (pos, name, args) ->
+        Hashtbl.hash (f pos, name, List.map ~f:(hash f) args)
+
   let v : t -> t' = fun t -> t
   let integer : S.pos -> string -> t = fun pos i -> Ast.Integer (pos, i)
 
diff --git a/lib/syntax/tree.mli b/lib/syntax/tree.mli
index 8ce577e..9ed442b 100644
--- a/lib/syntax/tree.mli
+++ b/lib/syntax/tree.mli
@@ -43,9 +43,18 @@ module Ast : sig
   [@@deriving eq, show]
 end
 
+(** Extend the default Expression module with an eq operator *)
+module Expression : sig
+  include S.Expression with type t' = S.pos Ast.expression
+
+  val eq : (S.pos -> S.pos -> bool) -> t' -> t' -> bool
+  val hash : (S.pos -> int) -> t' -> int
+  val exists : f:(t' -> bool) -> t' -> bool
+end
+
 include
   S.Analyzer
-    with type Expression.t' = S.pos Ast.expression
+    with module Expression := Expression
      and type Instruction.t' = S.pos Ast.statement
      and type Location.t = S.pos * S.pos Ast.statement list
      and type context = unit