1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
(** 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
module S = Qsp_syntax.S
module T = Qsp_syntax.T
module Report = Qsp_syntax.Report
module Tree = Qsp_syntax.Tree
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.warn hd message)
let v : t -> Report.t list =
fun t -> List.filter_map t ~f:v' |> List.sort_uniq ~cmp:Report.compare
end
|
