blob: 7ffd17c2d0957f0263f4647e598c7baeb71bc0f1 (
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
|
module S = Qsp_syntax.S
type pos = S.pos
let pp_pos = Qsp_syntax.Report.pp_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)
(** Build a parser for a specific check module *)
module M
(Checkable : Qsp_syntax.Analyzer.T with type ex = Qsp_syntax.Identifier.t) =
struct
let context_id = Type.Id.make ()
(* Build the test module with a single test inside. *)
module Check = Qsp_checks.Check.Make (struct
let t = [| Qsp_syntax.Identifier.build ~context_id (module Checkable) |]
end)
let _parse :
?context:Checkable.context ->
Qparser.Analyzer.lexer ->
string ->
(Check.Location.t Qparser.Analyzer.result, t) result =
fun ?context lexer content ->
let lexing =
Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf
in
(* Initialize the context *inside* the Check module. This works by
editing the context we created.
We have the context id (created at the begining of the module), which is
required to get the value. *)
let context =
match context with
| None -> Check.initialize ()
| Some c -> (
let init = Check.initialize () in
match Qsp_checks.Check.set context_id init.(0) c with
| None -> raise Not_found
| Some v ->
init.(0) <- v;
init)
in
Qparser.Analyzer.parse (module Check) lexer 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 msg -> failwith msg.message
let _test_instruction : string -> t list -> unit =
fun literal expected ->
let actual = get_report @@ _parse Qparser.Analyzer.Dynamic literal
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 = Checkable.initialize () in
let actual =
get_report @@ _parse ~context Qparser.Analyzer.Location _location
in
let () =
Alcotest.(
check' report ~msg:"Error reported during parsing" ~expected:[] ~actual)
in
let msg = literal in
let actual = Checkable.finalize context in
Alcotest.(check' report_global ~msg ~expected ~actual)
end
|
