blob: 2066c2226b797c8be1f813be5b7ef987f1303785 (
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
|
(** 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 : Qsp_syntax.Report.t list Alcotest.testable =
Alcotest.list @@ Alcotest.testable Qsp_syntax.Report.pp equal
let parse :
string ->
(Check.Location.t * Qsp_syntax.Report.t list, Qsp_syntax.Report.t) result
=
fun content ->
let lexing =
Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf
in
Qparser.Analyzer.parse (module Check) lexing
let get_report :
(Check.Location.t * Qsp_syntax.Report.t list, Qsp_syntax.Report.t) result ->
Qsp_syntax.Report.t list = function
| Ok (_, report) -> report
| Error _ -> failwith "Error"
let _test_instruction : string -> Qsp_syntax.Report.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)
end
|
