From 53c02501935b3cb2db78e79deb4d38c997505a95 Mon Sep 17 00:00:00 2001 From: Chimrod <> Date: Mon, 2 Dec 2024 09:05:18 +0100 Subject: Moved the checks in a dedicated library --- lib/syntax/dup_test.ml | 188 ------------------------------------------------- 1 file changed, 188 deletions(-) delete mode 100644 lib/syntax/dup_test.ml (limited to 'lib/syntax/dup_test.ml') diff --git a/lib/syntax/dup_test.ml b/lib/syntax/dup_test.ml deleted file mode 100644 index 20faa56..0000000 --- a/lib/syntax/dup_test.ml +++ /dev/null @@ -1,188 +0,0 @@ -(** 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 - - (* Report all the messages as error. They do not break the game, but - there is no question if it should *) - Some (Report.error hd message) - - let v : t -> Report.t list = - fun t -> List.filter_map t ~f:v' |> List.sort_uniq ~cmp:Report.compare -end -- cgit v1.2.3