aboutsummaryrefslogtreecommitdiff
path: root/test/make_checkTest.ml
diff options
context:
space:
mode:
Diffstat (limited to 'test/make_checkTest.ml')
-rw-r--r--test/make_checkTest.ml67
1 files changed, 45 insertions, 22 deletions
diff --git a/test/make_checkTest.ml b/test/make_checkTest.ml
index a863214..7ffd17c 100644
--- a/test/make_checkTest.ml
+++ b/test/make_checkTest.ml
@@ -1,30 +1,38 @@
-(** Build a parser for a specific check module *)
-module M (Check : Qsp_syntax.S.Analyzer) = struct
- module S = Qsp_syntax.S
+module S = Qsp_syntax.S
+
+type pos = S.pos
- let pp_pos = Qsp_syntax.Report.pp_pos
+let pp_pos = Qsp_syntax.Report.pp_pos
+let equal_pos : pos -> pos -> bool = fun _ _ -> true
- type pos = S.pos
+type t = Qsp_syntax.Report.t = {
+ level : Qsp_syntax.Report.level;
+ loc : pos;
+ message : string;
+}
+[@@deriving show, eq]
- let equal_pos : pos -> pos -> bool = fun _ _ -> true
+let report : t list Alcotest.testable =
+ Alcotest.list @@ Alcotest.testable Qsp_syntax.Report.pp equal
- type t = Qsp_syntax.Report.t = {
- level : Qsp_syntax.Report.level;
- loc : pos;
- message : string;
- }
- [@@deriving show, eq]
+let report_global : (string * t) list Alcotest.testable =
+ Alcotest.list
+ @@ Alcotest.pair Alcotest.string
+ (Alcotest.testable Qsp_syntax.Report.pp equal)
- let report : t list Alcotest.testable =
- Alcotest.list @@ 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 ()
- let report_global : (string * t) list Alcotest.testable =
- Alcotest.list
- @@ Alcotest.pair Alcotest.string
- (Alcotest.testable Qsp_syntax.Report.pp equal)
+ (* 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:Check.context ->
+ ?context:Checkable.context ->
Qparser.Analyzer.lexer ->
string ->
(Check.Location.t Qparser.Analyzer.result, t) result =
@@ -32,7 +40,22 @@ module M (Check : Qsp_syntax.S.Analyzer) = struct
let lexing =
Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf
in
- let context = Option.value context ~default:(Check.initialize ()) 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 :
@@ -55,7 +78,7 @@ module M (Check : Qsp_syntax.S.Analyzer) = struct
let _location = Printf.sprintf {|# Location
%s
------- |} literal in
- let context = Check.initialize () in
+ let context = Checkable.initialize () in
let actual =
get_report @@ _parse ~context Qparser.Analyzer.Location _location
in
@@ -64,6 +87,6 @@ module M (Check : Qsp_syntax.S.Analyzer) = struct
check' report ~msg:"Error reported during parsing" ~expected:[] ~actual)
in
let msg = literal in
- let actual = Check.finalize context in
+ let actual = Checkable.finalize context in
Alcotest.(check' report_global ~msg ~expected ~actual)
end