blob: d3ad358d76cbbd5ebca628fb9c08ff42f8be1caf (
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
|
(** Build a parser for a specific check module *)
module M (Check : Qsp_syntax.S.Analyzer) = struct
module S = Qsp_syntax.S
let pp_pos = Qsp_syntax.Report.pp_pos
type pos = S.pos
let equal_pos : pos -> pos -> bool = fun _ _ -> true
type t = Qsp_syntax.Report.t = {
level : Qsp_syntax.Report.level;
loc : pos;
message : string;
}
[@@deriving show, eq]
let report : t list Alcotest.testable =
Alcotest.list @@ Alcotest.testable Qsp_syntax.Report.pp equal
let report_global : (string * t) list Alcotest.testable =
Alcotest.list
@@ Alcotest.pair Alcotest.string
(Alcotest.testable Qsp_syntax.Report.pp equal)
let parse :
?context:Check.context ->
string ->
(Check.Location.t Qparser.Analyzer.result, t) result =
fun ?context content ->
let lexing =
Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf
in
let context = Option.value context ~default:(Check.initialize ()) in
Qparser.Analyzer.parse (module Check) lexing context
let get_report :
(Check.Location.t Qparser.Analyzer.result, Qsp_syntax.Report.t) result ->
Qsp_syntax.Report.t list = function
| Ok v -> v.report
| Error _ -> failwith "Error"
let _test_instruction : string -> t list -> unit =
fun literal expected ->
let _location = Printf.sprintf {|# Location
%s
------- |} literal in
let actual = get_report @@ parse _location and msg = literal in
Alcotest.(check' report ~msg ~expected ~actual)
(** Run a test over the whole file.
The parsing of the content shall not report any error.
*)
let global_check : string -> (string * t) list -> unit =
fun literal expected ->
let _location = Printf.sprintf {|# Location
%s
------- |} literal in
let context = Check.initialize () in
let actual = get_report @@ parse ~context _location in
let () =
Alcotest.(
check' report ~msg:"Error reported during parsing" ~expected:[] ~actual)
in
let msg = literal in
let actual = Check.finalize context in
Alcotest.(check' report_global ~msg ~expected ~actual)
end
|
