From 75f3eabb46eded01460f7700a75d094100047438 Mon Sep 17 00:00:00 2001
From: Chimrod <>
Date: Sat, 14 Dec 2024 23:06:12 +0100
Subject: Added dynamic check mecanism

---
 test/dynamics.ml | 93 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 93 insertions(+)
 create mode 100644 test/dynamics.ml

(limited to 'test/dynamics.ml')

diff --git a/test/dynamics.ml b/test/dynamics.ml
new file mode 100644
index 0000000..ad980f4
--- /dev/null
+++ b/test/dynamics.ml
@@ -0,0 +1,93 @@
+module Check = Make_checkTest.M (Qsp_checks.Dynamics)
+module S = Qsp_syntax.S
+
+let position = (Lexing.dummy_pos, Lexing.dummy_pos)
+
+module Testable = struct
+  type pos = S.pos
+
+  let pp_pos = Qsp_syntax.Report.pp_pos
+  let equal_pos : pos -> pos -> bool = fun _ _ -> true
+
+  type t = Qsp_checks.Dynamics.text = { content : string; position : pos }
+  [@@deriving show, eq]
+
+  let v = Alcotest.list (Alcotest.testable pp equal)
+end
+
+let _parse : string -> Testable.t list -> unit =
+ fun literal expected ->
+  let context = Qsp_checks.Dynamics.initialize () in
+  (* The result of the parsing can be discarded, the usefull information is in
+     the context *)
+  let result =
+    Check._parse ~context Qparser.Analyzer.Dynamic (literal ^ "\n")
+  in
+  match result with
+  | Ok _ ->
+      let actual : Qsp_checks.Dynamics.text List.t =
+        Qsp_checks.Dynamics.dynamics_string context |> List.of_seq
+      in
+      let msg = literal in
+      Alcotest.(check' Testable.v ~msg ~expected ~actual)
+  | Error _ -> raise (Failure "Syntax error")
+
+let test_direct () =
+  _parse "dynamic '$a = 1'"
+    [ { Qsp_checks.Dynamics.content = "$a = 1"; position } ]
+
+let test_indirect () =
+  _parse "$test = '$a = 1' & dynamic $test"
+    [ { Qsp_checks.Dynamics.content = "$a = 1"; position } ]
+
+let test_indirect_array () =
+  _parse "$test[0] = '$a = 1' & dynamic $test[0]"
+    [ { Qsp_checks.Dynamics.content = "$a = 1"; position } ];
+
+  _parse "$test['a'] = '$a = 1' & dynamic $test['a']"
+    [ { Qsp_checks.Dynamics.content = "$a = 1"; position } ];
+
+  _parse "$test[0] = '$a = 1' & dynamic $test[1]" []
+
+(** If a variable is identified as dynamic, check all the differents values this
+    variable can have *)
+let test_reassignation () =
+  _parse
+    {|$test = '$a = 1' 
+    $test = '$a = 2' 
+    dynamic $test|}
+    [
+      { Qsp_checks.Dynamics.content = "$a = 1"; position };
+      { Qsp_checks.Dynamics.content = "$a = 2"; position };
+    ]
+
+(** If the variable contains a dynamic assignation, blacklist it from being
+    checkable*)
+let test_blacklist () =
+  _parse {|$test = '$a = 1' 
+    $test = $b + '' 
+    dynamic $test|} []
+
+(** Ignore string template because this can be anything *)
+let test_template_str () = _parse "dynamic '$a = <<$other>>'" []
+
+let test_template_str2 () =
+  _parse {|dynamic '$a = <<"other">>'|}
+    [ { Qsp_checks.Dynamics.content = "$a = other"; position } ]
+
+let test_template_int () =
+  _parse "dynamic '$a = <<other>>'"
+    [ { Qsp_checks.Dynamics.content = "$a = 0"; position } ]
+
+let test =
+  ( "Dynamic evaluation checker",
+    [
+      Alcotest.test_case "direct" `Quick test_direct;
+      Alcotest.test_case "indirect" `Quick test_indirect;
+      Alcotest.test_case "indirect array" `Quick test_indirect_array;
+      Alcotest.test_case "template" `Quick test_template_str;
+      Alcotest.test_case "template" `Quick test_template_str2;
+      Alcotest.test_case "template int" `Quick test_template_int;
+      Alcotest.test_case "reassignation" `Quick test_reassignation;
+      Alcotest.test_case "blacklist" `Quick test_blacklist;
+    ] )
-- 
cgit v1.2.3