diff options
| -rw-r--r-- | lib/syntax/type_of.ml | 31 | ||||
| -rw-r--r-- | test/type_of.ml | 46 |
2 files changed, 48 insertions, 29 deletions
diff --git a/lib/syntax/type_of.ml b/lib/syntax/type_of.ml index 410a0b1..b991e43 100644 --- a/lib/syntax/type_of.ml +++ b/lib/syntax/type_of.ml @@ -55,12 +55,12 @@ module Helper = struct (* Strict equality for this ones, always true *) | String, Variable String | String, Raw String - | String, Raw NumericString | String, Variable NumericString + | String, Raw NumericString | Integer, Variable Integer | Integer, Raw Integer - | NumericString, Raw NumericString | NumericString, Variable NumericString + | NumericString, Raw NumericString | Bool, Raw Bool | Bool, Variable Bool (* Also include the conversion between bool and integer *) @@ -71,9 +71,7 @@ module Helper = struct | NumericString, Raw String | NumericString, Variable String | NumericString, Raw Integer - | NumericString, Variable Integer - (* A numeric type can be used at any place *) - | String, Raw Integer -> + | NumericString, Variable Integer -> true | Bool, Variable Integer when not strict -> true | Bool, Raw Integer when not strict -> true @@ -81,9 +79,9 @@ module Helper = struct | String, Raw Bool when not strict -> true | String, Variable Bool when not strict -> true | Integer, Variable String when not strict -> true - (* Explicit rejected cases *) | Integer, Raw NumericString when not strict -> true - | Integer, Raw String -> false + (* Explicit rejected cases *) + | String, Raw Integer | Integer, Raw String -> false | _, _ -> false in if equal then report @@ -341,23 +339,26 @@ module TypedExpression = struct let report = Helper.compare_args pos expected types report in ({ pos; empty = false }, report) - | T.Eq | T.Neq -> + | T.Eq | T.Neq | Lt | Gte | Lte | Gt -> (* If the expression is '' or 0, we accept the comparaison as if instead of raising a warning *) if t1.empty || t2.empty then ({ pos; empty = false }, report) else let d = Helper.(Dynamic (DynType.t ())) in let expected = [ d; d ] in + (* Compare and report as error if the types are incompatible. If no + error is reported, try in strict mode, and report as a warning. *) let report = - Helper.compare_args ~strict:true pos expected (List.rev types) - report + match + Helper.compare_args ~level:Error pos expected (List.rev types) + report + with + | [] -> + Helper.compare_args ~strict:true pos expected (List.rev types) + report + | report -> report in ({ pos; empty = false }, report) - | Lt | Gte | Lte | Gt -> - let d = Helper.(Dynamic (DynType.t ())) in - let expected = [ d; d ] in - let report = Helper.compare_args pos expected types report in - ({ pos; empty = false }, report) | T.Mod | T.Minus | T.Product | T.Div -> (* Operation over number *) let expected = Helper.[ Fixed Integer; Fixed Integer ] in diff --git a/test/type_of.ml b/test/type_of.ml index bca7ea0..a387bf6 100644 --- a/test/type_of.ml +++ b/test/type_of.ml @@ -2,28 +2,31 @@ module Check = Make_checkTest.M (Qsp_syntax.Type_of) let _position = (Lexing.dummy_pos, Lexing.dummy_pos) -let _test_instruction : string -> Qsp_syntax.Report.t list -> unit = - Check._test_instruction - -let type_mismatch () = - _test_instruction {|abc = 'ABC'|} - [ +let message level = + [ + Qsp_syntax.Report. { - level = Error; + level; loc = _position; message = "The type Integer is expected but got String"; }; - ] + ] -let type_mismatch2 () = - _test_instruction {|abc[''] = $Var|} - [ +let message' level = + [ + Qsp_syntax.Report. { - level = Warn; + level; loc = _position; - message = "The type Integer is expected but got String"; + 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 type_mismatch2 () = _test_instruction {|abc[''] = $Var|} (message Warn) let type_conversion () = _test_instruction {|abc = '123'|} @@ -39,6 +42,15 @@ let type_conversion () = 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')|} @@ -68,6 +80,12 @@ let test = 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; ] ) |