New test for duplicates evalutations in the code

1 files changed, 187 insertions, 0 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