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/dup_cases.ml       | 10 +++---
 test/dynamics.ml        | 93 +++++++++++++++++++++++++++++++++++++++++++++++++
 test/literals.ml        | 15 ++++++++
 test/location.ml        | 10 ++++++
 test/make_checkTest.ml  | 24 ++++++-------
 test/qsp_parser_test.ml |  1 +
 test/syntax.ml          |  7 ++--
 7 files changed, 140 insertions(+), 20 deletions(-)
 create mode 100644 test/dynamics.ml

(limited to 'test')

diff --git a/test/dup_cases.ml b/test/dup_cases.ml
index 8b9f846..76a1157 100644
--- a/test/dup_cases.ml
+++ b/test/dup_cases.ml
@@ -28,8 +28,7 @@ elseif rnd:
 end
 |} []
 
-(** The same test in two differents block shall be considered as a duplicate.
- *)
+(** The same test in two differents block shall be considered as a duplicate. *)
 let ok_act () =
   _test_instruction
     {|
@@ -61,14 +60,13 @@ end
       {
         level = Warn;
         loc = _position;
-        message = "This case is duplicated line(s) 5";
+        message = "This case is duplicated line(s) 4";
       };
     ]
 
 let duplicate_root_test () =
   _test_instruction
-    {|
-if args[0] = 1: 
+    {|if args[0] = 1: 
     0
 end
 if args[0] = 1: 
@@ -81,7 +79,7 @@ end
       {
         level = Warn;
         loc = _position;
-        message = "This case is duplicated line(s) 6";
+        message = "This case is duplicated line(s) 4";
       };
     ]
 
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;
+    ] )
diff --git a/test/literals.ml b/test/literals.ml
index f98fa8f..2685538 100644
--- a/test/literals.ml
+++ b/test/literals.ml
@@ -107,6 +107,20 @@ let multiple_expression () =
              ] ));
     ]
 
+let int_expression () =
+  _test_instruction {|"<<expr2>>"|}
+    [
+      Tree.Ast.Expression
+        (Tree.Ast.Literal
+           ( _position,
+             [
+               T.Expression
+                 (Tree.Ast.Ident
+                    { Tree.Ast.pos = _position; name = "EXPR2"; index = None });
+               T.Text "";
+             ] ));
+    ]
+
 let test =
   ( "Literals",
     [
@@ -127,4 +141,5 @@ let test =
       Alcotest.test_case "elements_sequence" `Quick elements_sequence;
       Alcotest.test_case "expression" `Quick expression;
       Alcotest.test_case "multiple_expression" `Quick multiple_expression;
+      Alcotest.test_case "multiple_expression" `Quick int_expression;
     ] )
diff --git a/test/location.ml b/test/location.ml
index a1939f4..cf2008f 100644
--- a/test/location.ml
+++ b/test/location.ml
@@ -18,6 +18,14 @@ let ok_upper () = Check.global_check "gt 'LOCATION'" []
 let missing_gt () = Check.global_check "gt 'unknown_place'" error_message
 let missing_gs () = Check.global_check "gs 'unknown_place'" error_message
 
+let act_missing_gs () =
+  Check.global_check {|
+act "test": gs 'unknown_place'|} error_message
+
+let if_missing_gs () =
+  Check.global_check {|
+  if 0: gs 'unknown_place'|} error_message
+
 let test =
   ( "Locations",
     [
@@ -25,4 +33,6 @@ let test =
       Alcotest.test_case "Ok upper" `Quick ok_upper;
       Alcotest.test_case "Missing GT" `Quick missing_gt;
       Alcotest.test_case "Missing GS" `Quick missing_gs;
+      Alcotest.test_case "Missing GS in block" `Quick act_missing_gs;
+      Alcotest.test_case "Missing GS in block'" `Quick if_missing_gs;
     ] )
diff --git a/test/make_checkTest.ml b/test/make_checkTest.ml
index d3ad358..a863214 100644
--- a/test/make_checkTest.ml
+++ b/test/make_checkTest.ml
@@ -23,42 +23,42 @@ module M (Check : Qsp_syntax.S.Analyzer) = struct
     @@ Alcotest.pair Alcotest.string
          (Alcotest.testable Qsp_syntax.Report.pp equal)
 
-  let parse :
+  let _parse :
       ?context:Check.context ->
+      Qparser.Analyzer.lexer ->
       string ->
       (Check.Location.t Qparser.Analyzer.result, t) result =
-   fun ?context content ->
+   fun ?context lexer content ->
     let lexing =
       Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf
     in
     let context = Option.value context ~default:(Check.initialize ()) in
-    Qparser.Analyzer.parse (module Check) lexing context
+    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 _ -> failwith "Error"
+    | Error msg -> failwith msg.message
 
   let _test_instruction : string -> t list -> unit =
    fun literal expected ->
-    let _location = Printf.sprintf {|# Location
-%s
-------- |} literal in
-    let actual = get_report @@ parse _location and msg = literal in
+    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.
-   *)
+  (** 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 = Check.initialize () in
-    let actual = get_report @@ parse ~context _location in
+    let actual =
+      get_report @@ _parse ~context Qparser.Analyzer.Location _location
+    in
     let () =
       Alcotest.(
         check' report ~msg:"Error reported during parsing" ~expected:[] ~actual)
diff --git a/test/qsp_parser_test.ml b/test/qsp_parser_test.ml
index 43f9cb3..4ae5a4c 100644
--- a/test/qsp_parser_test.ml
+++ b/test/qsp_parser_test.ml
@@ -11,4 +11,5 @@ let () =
       Nested_string.test;
       Location.test;
       Dup_cases.test;
+      Dynamics.test;
     ]
diff --git a/test/syntax.ml b/test/syntax.ml
index db449b1..ff5a3ca 100644
--- a/test/syntax.ml
+++ b/test/syntax.ml
@@ -4,7 +4,8 @@ module Check = Qsp_checks.Check
 module S = Qsp_syntax.S
 module T = Qsp_syntax.T
 
-let location_id, e1 = Qsp_syntax.Catalog.build (module Tree)
+let location_id = Type.Id.make ()
+let e1 = Qsp_syntax.Catalog.build ~location_id (module Tree)
 
 module Parser = Check.Make (struct
   let t = [| e1 |]
@@ -28,7 +29,9 @@ let parse : string -> (S.pos location, Qsp_syntax.Report.t) result =
     Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf
   in
   let context = Parser.initialize () in
-  Qparser.Analyzer.parse (module Parser) lexing context
+  Qparser.Analyzer.parse
+    (module Parser)
+    Qparser.Analyzer.Location lexing context
   |> Result.map (fun v ->
          (* Uncatched excteptions here, but we are in the tests…
             If it’s fail here I have an error in the code. *)
-- 
cgit v1.2.3