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