From e6053d23747c09acfb3169e923dbac0e5a02b495 Mon Sep 17 00:00:00 2001
From: Chimrod <>
Date: Tue, 11 Jun 2024 23:22:22 +0200
Subject: New tests and more typecheck

---
 lib/syntax/type_of.ml | 44 ++++++++++++++++++++++++++------------------
 1 file changed, 26 insertions(+), 18 deletions(-)

(limited to 'lib/syntax')

diff --git a/lib/syntax/type_of.ml b/lib/syntax/type_of.ml
index 91b8c57..ee6b314 100644
--- a/lib/syntax/type_of.ml
+++ b/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
-- 
cgit v1.2.3