New tests and more typecheck

lib/syntax/type_of.ml

@@ -43,13 +43,13 @@ module Helper = struct
     | Variable of argument
 
   let compare :
-      ?strict:bool ->
       ?level:Report.level ->
+      strict:bool ->
       Get_type.type_of ->
       argument_repr ->
       Report.t list ->
       Report.t list =
-   fun ?(strict = false) ?(level = Report.Warn) expected actual report ->
+   fun ?(level = Report.Warn) ~strict expected actual report ->
     let equal =
       match (expected, actual.t) with
       (* Strict equality for this ones, always true *)
@@ -73,13 +73,14 @@ module Helper = struct
       | NumericString, Raw Integer
       | NumericString, Variable Integer ->
           true
-      | Bool, Variable Integer when not strict -> true
-      | Bool, Raw Integer when not strict -> true
-      | String, Variable Integer when not strict -> true
-      | String, Raw Bool when not strict -> true
-      | String, Variable Bool when not strict -> true
-      | Integer, Variable String when not strict -> true
-      | Integer, Raw NumericString when not strict -> true
+      | Bool, Variable Integer
+      | Bool, Raw Integer
+      | String, Variable Integer
+      | String, Raw Bool
+      | String, Variable Bool
+      | Integer, Variable String
+      | Integer, Raw NumericString ->
+          not strict
       (* Explicit rejected cases  *)
       | String, Raw Integer | Integer, Raw String -> false
       | _, _ -> false
@@ -94,19 +95,19 @@ module Helper = struct
       Report.message level actual.pos message :: report
 
   let rec compare_parameter :
-      ?strict:bool ->
+      strict:bool ->
       ?level:Report.level ->
       argument ->
       argument_repr ->
       Report.t list ->
       Report.t list =
-   fun ?(strict = false) ?(level = Report.Warn) expected param report ->
+   fun ~strict ?(level = Report.Warn) expected param report ->
     match expected with
-    | Fixed t -> compare ~level t param report
+    | Fixed t -> compare ~strict ~level t param report
     | Dynamic d ->
         let type_ = match d param.t with Raw r -> r | Variable v -> v in
         compare ~strict ~level type_ param report
-    | Variable c -> compare_parameter ~level c param report
+    | Variable c -> compare_parameter ~level ~strict c param report
 
   (** Compare the arguments one by one *)
   let compare_args :
@@ -393,7 +394,9 @@ module Instruction = struct
     let result, r = expr in
 
     let r2 =
-      Helper.compare Get_type.Bool (arg_of_repr result.result result.pos) []
+      Helper.compare ~strict:false Get_type.Bool
+        (arg_of_repr result.result result.pos)
+        []
     in
 
     List.fold_left instructions
@@ -424,7 +427,7 @@ module Instruction = struct
    fun _pos ~label instructions ->
     let result, report = label in
     let report =
-      Helper.compare Get_type.String
+      Helper.compare ~strict:false Get_type.String
         (arg_of_repr result.result result.pos)
         report
     in
@@ -450,10 +453,15 @@ module Instruction = struct
         op,
         Get_type.get_type (Lazy.force right_expression.result) )
     with
-    | true, _, _
-    (* It’s allowed to assign an integer in any kind of variable *)
+    | true, _, _ -> report
     | _, T.Eq', Get_type.(Integer) ->
-        report
+        (* Assigning an intger is allowed in a string variable, but raise a
+           warning. *)
+        let var_type = Lazy.from_val (Get_type.ident variable) in
+        let op1 = arg_of_repr var_type variable.pos in
+        let expected = Helper.[ Fixed Integer ] in
+        Helper.compare_args ~strict:true ~level:Report.Warn pos expected [ op1 ]
+          report
     | false, _, _ -> (
         let var_type = Lazy.from_val (Get_type.ident variable) in
         let op1 = arg_of_repr var_type variable.pos in

test/type_of.ml

@@ -26,7 +26,7 @@ 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 assign_int_str () = _test_instruction {|$abc = 123|} (message Warn)
 let type_mismatch2 () = _test_instruction {|abc[''] = $Var|} (message Warn)
 
 let type_conversion () =
@@ -80,7 +80,7 @@ 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 "$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';
@@ -94,5 +94,5 @@ let test =
       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;
+      Alcotest.test_case "str += int" `Quick increment_string;
     ] )