aboutsummaryrefslogtreecommitdiff
path: root/test/dynamics.ml
blob: ad980f40254377a7e6a3ba398d1bb4fb4f4c19ac (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
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;
    ] )