aboutsummaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
authorChimrod <>2025-07-19 11:18:24 +0200
committerChimrod <>2025-08-01 14:12:14 +0200
commit3046fb0d0c1ceac2c6a6ca9456e9e05671e0cef9 (patch)
tree8ba2700e541a6753499ceac54ced4f1d02a3b625 /test
parent406b7b79cd375b071f92ddee9cee14a98dc91281 (diff)
Added dependencies system between the modules in the checksHEADmaster
Diffstat (limited to 'test')
-rw-r--r--test/get_type.ml68
-rw-r--r--test/location.ml4
-rw-r--r--test/make_checkTest.ml67
-rw-r--r--test/syntax.ml2
-rw-r--r--test/type_of.ml2
5 files changed, 86 insertions, 57 deletions
diff --git a/test/get_type.ml b/test/get_type.ml
index 55f087e..56b4689 100644
--- a/test/get_type.ml
+++ b/test/get_type.ml
@@ -3,79 +3,84 @@ module T = Qsp_syntax.T
let _position = (Lexing.dummy_pos, Lexing.dummy_pos)
-let type_of : Get_type.t Alcotest.testable =
- Alcotest.testable Get_type.pp Get_type.equal
+let type_of : Get_type.Expression.t Alcotest.testable =
+ Alcotest.testable Get_type.Expression.pp Get_type.Expression.equal
+
+let ctx = Qsp_syntax.S.{ f = (fun _ -> None) }
let add_number () =
let actual =
- Get_type.boperator _position T.Plus
- (Get_type.integer _position "0")
- (Get_type.integer _position "1")
+ Get_type.Expression.boperator ~ctx _position T.Plus
+ (Get_type.Expression.integer ~ctx _position "0")
+ (Get_type.Expression.integer ~ctx _position "1")
in
- let expected = Get_type.(Raw Integer) in
+ let expected = Get_type.Expression.(Raw Integer) in
let msg = "Adding integer" in
Alcotest.(check' type_of ~msg ~expected ~actual)
let add_literal_number () =
let actual =
- Get_type.boperator _position T.Plus
- (Get_type.literal _position [ T.Text "2" ])
- (Get_type.integer _position "1")
+ Get_type.Expression.boperator ~ctx _position T.Plus
+ (Get_type.Expression.literal ~ctx _position [ T.Text "2" ])
+ (Get_type.Expression.integer ~ctx _position "1")
in
- let expected = Get_type.(Raw Integer) in
+ let expected = Get_type.Expression.(Raw Integer) in
let msg = "A string containing integer is considered as integer" in
Alcotest.(check' type_of ~msg ~expected ~actual)
let concat_text () =
let actual =
- Get_type.boperator _position T.Plus
- (Get_type.literal _position [ T.Text "a" ])
- (Get_type.integer _position "1")
+ Get_type.Expression.boperator ~ctx _position T.Plus
+ (Get_type.Expression.literal ~ctx _position [ T.Text "a" ])
+ (Get_type.Expression.integer ~ctx _position "1")
in
- let expected = Get_type.(Raw String) in
+ let expected = Get_type.Expression.(Raw String) in
let msg = "Concatenate" in
Alcotest.(check' type_of ~msg ~expected ~actual)
let literal_1 () =
let actual =
- Get_type.literal _position [ T.Expression (Get_type.Raw Integer) ]
- and expected = Get_type.(Raw NumericString) in
+ Get_type.Expression.literal ~ctx _position
+ [ T.Expression (Get_type.Expression.Raw Integer) ]
+ and expected = Get_type.Expression.(Raw NumericString) in
let msg = "" in
Alcotest.(check' type_of ~msg ~expected ~actual)
let literal_2 () =
let actual =
- Get_type.literal _position
- Get_type.[ T.Text "1"; T.Expression (Raw Integer) ]
- and expected = Get_type.(Raw NumericString) in
+ Get_type.Expression.literal ~ctx _position
+ Get_type.Expression.[ T.Text "1"; T.Expression (Raw Integer) ]
+ and expected = Get_type.Expression.(Raw NumericString) in
let msg = "" in
Alcotest.(check' type_of ~msg ~expected ~actual)
let literal_3 () =
let actual =
- Get_type.literal _position
- Get_type.[ T.Text "b"; T.Expression (Raw Integer) ]
- and expected = Get_type.(Raw String) in
+ Get_type.Expression.literal ~ctx _position
+ Get_type.Expression.[ T.Text "b"; T.Expression (Raw Integer) ]
+ and expected = Get_type.Expression.(Raw String) in
let msg = "" in
Alcotest.(check' type_of ~msg ~expected ~actual)
let literal_4 () =
let actual =
- Get_type.literal _position [ T.Expression (Get_type.Variable Integer) ]
- and expected = Get_type.(Variable NumericString) in
+ Get_type.Expression.literal ~ctx _position
+ Get_type.Expression.[ T.Expression (Variable Integer) ]
+ and expected = Get_type.Expression.(Variable NumericString) in
let msg = "" in
Alcotest.(check' type_of ~msg ~expected ~actual)
let min () =
- let actual = Get_type.function_ _position T.Min [] in
- let expected = Get_type.(Raw Bool) in
+ let actual = Get_type.Expression.function_ ~ctx _position T.Min [] in
+ let expected = Get_type.Expression.(Raw Bool) in
let msg = "The function min without argument return a default value" in
Alcotest.(check' type_of ~msg ~expected ~actual);
let actual =
- Get_type.function_ _position T.Min [ Get_type.literal _position [] ]
+ Get_type.Expression.function_ ~ctx _position T.Min
+ [ Get_type.Expression.literal ~ctx _position [] ]
in
- let expected = Get_type.(Variable NumericString) in
+ let expected = Get_type.Expression.(Variable NumericString) in
let msg =
"The function min with a literal will take the literal as the name of an \
array"
@@ -83,10 +88,11 @@ let min () =
Alcotest.(check' type_of ~msg ~expected ~actual);
let actual =
- Get_type.function_ _position T.Min
- [ Get_type.integer _position ""; Get_type.integer _position "" ]
+ Get_type.Expression.function_ ~ctx _position T.Min
+ Get_type.Expression.
+ [ integer ~ctx _position ""; integer ~ctx _position "" ]
in
- let expected = Get_type.(Raw Integer) in
+ let expected = Get_type.Expression.(Raw Integer) in
let msg = "With two or more arguments, return the type of the first one" in
Alcotest.(check' type_of ~msg ~expected ~actual)
diff --git a/test/location.ml b/test/location.ml
index cf2008f..decf270 100644
--- a/test/location.ml
+++ b/test/location.ml
@@ -5,7 +5,7 @@ let _position = (Lexing.dummy_pos, Lexing.dummy_pos)
let error_message =
[
( "Location",
- Check.
+ Make_checkTest.
{
level = Error;
loc = _position;
@@ -27,7 +27,7 @@ let if_missing_gs () =
if 0: gs 'unknown_place'|} error_message
let test =
- ( "Locations",
+ ( __FILE__,
[
Alcotest.test_case "Ok" `Quick ok;
Alcotest.test_case "Ok upper" `Quick ok_upper;
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
diff --git a/test/syntax.ml b/test/syntax.ml
index ff5a3ca..ce3e89e 100644
--- a/test/syntax.ml
+++ b/test/syntax.ml
@@ -5,7 +5,7 @@ module S = Qsp_syntax.S
module T = Qsp_syntax.T
let location_id = Type.Id.make ()
-let e1 = Qsp_syntax.Catalog.build ~location_id (module Tree)
+let e1 = Qsp_syntax.Identifier.build ~location_id (module Tree)
module Parser = Check.Make (struct
let t = [| e1 |]
diff --git a/test/type_of.ml b/test/type_of.ml
index e816bc7..1b84faa 100644
--- a/test/type_of.ml
+++ b/test/type_of.ml
@@ -78,7 +78,7 @@ let concat_text () = _test_instruction {|$a = 'A' + 1|} []
let increment_string () = _test_instruction {|$a += 1|} (message' Error)
let test =
- ( "Typechecking",
+ ( __FILE__,
[
Alcotest.test_case "Assign str to int" `Quick type_mismatch;
Alcotest.test_case "$str = int" `Quick assign_int_str;