blob: 3eb6b939b97a111d4f24ec8cad6924b56b336870 (
plain)
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
|
open StdLabels
(** Witness used to extract the values in the module Qsp_checks.Dynamics during
the parsing. *)
let dynamic_context_id : Qsp_checks.Dynamics.context Type.Id.t = Type.Id.make ()
(*
List all the controls to apply
*)
let available_checks =
[
Qsp_syntax.Identifier.build ~context_id:dynamic_context_id
(module Qsp_checks.Dynamics);
Qsp_syntax.Identifier.build (module Qsp_checks.Type_of);
Qsp_syntax.Identifier.build (module Qsp_checks.Dead_end);
Qsp_syntax.Identifier.build (module Qsp_checks.Nested_strings);
Qsp_syntax.Identifier.build (module Qsp_checks.Locations);
Qsp_syntax.Identifier.build (module Qsp_checks.Dup_test);
Qsp_syntax.Identifier.build (module Qsp_checks.Write_only);
]
(** Get all the tests to apply.
The expression is declared lazy in order to be sure to apply the filters
from the command line before. *)
let checkers :
(module Qsp_syntax.Analyzer.T
with type context = Qsp_checks.Check.result array)
Lazy.t =
lazy
(let module Check = Qsp_checks.Check.Make (struct
let t =
List.filter available_checks ~f:(fun v ->
let (module A : Qsp_syntax.Analyzer.T) =
Qsp_syntax.Identifier.get_module v
in
!A.active)
|> Array.of_list
end) in
(module Check))
let get_report :
(module Qsp_syntax.Analyzer.T
with type context = Qsp_checks.Check.result array) ->
Qsp_checks.Check.result array ->
Qparser.Lexbuf.t ->
(Qsp_syntax.Report.t list, Qsp_syntax.Report.t) result =
fun (module Check) context lexbuf ->
let result =
Qparser.Analyzer.parse
(module Check)
Qparser.Analyzer.Location lexbuf context
in
(* Also analyse eache dynamic string identified in the module *)
Result.map
(fun r ->
let found_report =
Array.find_map context ~f:(fun value ->
Qsp_checks.Check.get dynamic_context_id value)
in
match found_report with
| None -> r.Qparser.Analyzer.report
| Some dyn_context ->
let seq : Qsp_checks.Dynamics.text Seq.t =
Qsp_checks.Dynamics.dynamics_string dyn_context
in
Seq.fold_left
(fun r content ->
let text = content.Qsp_checks.Dynamics.content ^ "\n" in
let lexing =
Sedlexing.Latin1.from_string text
|> Qparser.Lexbuf.from_lexbuf
~position:(fst content.Qsp_checks.Dynamics.position)
in
let dyn_report =
Qparser.Analyzer.parse
(module Check)
Qparser.Analyzer.Dynamic lexing context
in
match dyn_report with
| Error e ->
(* Syntax error are not blocking here, but are transformed
into check error *)
e :: r
| Ok dyn_ok_reports -> dyn_ok_reports.Qparser.Analyzer.report @ r)
r.Qparser.Analyzer.report seq)
result
|
