blob: aac928e95b1b93a9aaca1ef94edf8e55ec2a986f (
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
94
95
96
|
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 _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|} []
let type_mismatch2 () = _test_instruction {|abc[''] = $Var|} (message Warn)
let type_conversion () =
_test_instruction {|abc = '123'|}
[
{
level = Warn;
loc = _position;
message = "The type Integer is expected but got Integer as String";
};
]
(** This expression is not considered as a string *)
let type_conversion' () = _test_instruction {|abc = '<<123>>'|} []
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 test =
( "Typechecking",
[
Alcotest.test_case "Assign str to int" `Quick type_mismatch;
Alcotest.test_case "Assign int to str" `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;
] )
|
