Enforced the type_of checker

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;
     ] )