qsp_parser/test/type_of.ml

module Check = Make_checkTest.M (Qsp_syntax.Type_of)

let _position = (Lexing.dummy_pos, Lexing.dummy_pos)

let message level =
  [
    Qsp_syntax.Report.
      {
        level;
        loc = _position;
        message = "The type Integer is expected but got String";
      };
  ]

let message' level =
  [
    Qsp_syntax.Report.
      {
        level;
        loc = _position;
        message = "The type String is expected but got Integer";
      };
  ]

let integer_as_string =
  [
    Qsp_syntax.Report.
      {
        level = Warn;
        loc = _position;
        message = "The type Integer is expected but got Integer as String";
      };
  ]

let _test_instruction : string -> Qsp_syntax.Report.t list -> unit =
  Check._test_instruction

let type_mismatch () = _test_instruction {|abc = 'ABC'|} (message Error)
let assign_int_str () = _test_instruction {|$abc = 123|} (message Warn)
let type_mismatch2 () = _test_instruction {|abc[''] = $Var|} (message Warn)
let type_conversion () = _test_instruction {|abc = '123'|} integer_as_string

let type_conversion' () =
  _test_instruction {|abc = '<<123>>'|} integer_as_string

let type_comparaison () = _test_instruction {|(abc = '123')|} []
let type_comparaison_eq () = _test_instruction {|($abc = 123)|} (message Warn)
let type_comparaison_eq' () = _test_instruction {|(1 = "abc")|} (message' Error)
let type_comparaison_gte () = _test_instruction {|($abc >= 123)|} (message Warn)

let type_comparaison_gte' () =
  _test_instruction {|(1 >= "abc")|} (message' Error)

let type_comparaison_gt () = _test_instruction {|($abc > 123)|} (message Warn)
let type_comparaison_gt' () = _test_instruction {|(123 > 'a')|} (message' Error)

let type_comparaison_mismatch () =
  _test_instruction {|(abc = 'ABC')|}
    [
      {
        level = Warn;
        loc = _position;
        message = "The type String is expected but got Integer";
      };
    ]

let wrong_predicate () =
  _test_instruction {| if $var and 1: 0 |}
    [
      {
        level = Warn;
        loc = _position;
        message = "The type Bool is expected but got String";
      };
    ]

let concat_text () = _test_instruction {|$a = 'A' + 1|} []
let increment_string () = _test_instruction {|$a += 1|} (message' Error)

let test =
  ( "Typechecking",
    [
      Alcotest.test_case "Assign str to int" `Quick type_mismatch;
      Alcotest.test_case "$str = int" `Quick assign_int_str;
      Alcotest.test_case "Assign array" `Quick type_mismatch2;
      Alcotest.test_case "Conversion" `Quick type_conversion;
      Alcotest.test_case "Conversion'" `Quick type_conversion';
      Alcotest.test_case "Comparaison" `Quick type_comparaison;
      Alcotest.test_case "eq(str, int)" `Quick type_comparaison_eq;
      Alcotest.test_case "eq(int, str)" `Quick type_comparaison_eq';
      Alcotest.test_case "gte(str, int)" `Quick type_comparaison_gte;
      Alcotest.test_case "gte(int, str)" `Quick type_comparaison_gte';
      Alcotest.test_case "gt(str, int)" `Quick type_comparaison_gt;
      Alcotest.test_case "gt(int, str)" `Quick type_comparaison_gt';
      Alcotest.test_case "Comparaison Mismatch" `Quick type_comparaison_mismatch;
      Alcotest.test_case "Wrong predicate" `Quick wrong_predicate;
      Alcotest.test_case "+(int, str)" `Quick concat_text;
      Alcotest.test_case "str += int" `Quick increment_string;
    ] )