diff options
-rw-r--r-- | lib/syntax/get_type.ml | 4 | ||||
-rw-r--r-- | lib/syntax/type_of.ml | 17 | ||||
-rw-r--r-- | test/get_type.ml | 45 | ||||
-rw-r--r-- | test/qsp_parser_test.ml | 1 | ||||
-rw-r--r-- | test/type_of.ml | 3 |
5 files changed, 55 insertions, 15 deletions
diff --git a/lib/syntax/get_type.ml b/lib/syntax/get_type.ml index c8af9ec..442f49f 100644 --- a/lib/syntax/get_type.ml +++ b/lib/syntax/get_type.ml @@ -7,9 +7,9 @@ type type_of = | NumericString [@printer fun fmt _ -> Format.pp_print_string fmt "Integer as String"] (** String containing a numeric value *) -[@@deriving show { with_path = false }] +[@@deriving show { with_path = false }, eq] -type t = Variable of type_of | Raw of type_of +type t = Variable of type_of | Raw of type_of [@@deriving show, eq] type t' = t let v = Fun.id diff --git a/lib/syntax/type_of.ml b/lib/syntax/type_of.ml index d0437c9..6c02e91 100644 --- a/lib/syntax/type_of.ml +++ b/lib/syntax/type_of.ml @@ -324,20 +324,11 @@ module TypedExpression = struct match operator with | T.Plus -> - let d = Helper.DynType.t () in - (* Remove the empty elements *) - let types = - List.filter_map - [ (type_1, t1); (type_2, t2) ] - ~f:(fun (type_of, t) -> - (* TODO could be added in the logs *) - match t.empty with - | true -> None - | false -> Some (arg_of_repr type_of t.pos)) - in - let expected = List.map types ~f:(fun _ -> Helper.Dynamic d) in + (* We cannot really much here, because the (+) function can be used to + concatenate string or add numbers. - let report = Helper.compare_args pos expected types report in + When concatenating, it’s allowed to add an integer and a number. + *) ({ pos; empty = false }, report) | T.Eq | T.Neq | Lt | Gte | Lte | Gt -> (* If the expression is '' or 0, we accept the comparaison as if diff --git a/test/get_type.ml b/test/get_type.ml new file mode 100644 index 0000000..d7bb333 --- /dev/null +++ b/test/get_type.ml @@ -0,0 +1,45 @@ +module Get_type = Qsp_syntax.Get_type +module T = Qsp_syntax.T + +let _position = (Lexing.dummy_pos, Lexing.dummy_pos) + +let type_of : Get_type.t Alcotest.testable = + Alcotest.testable Get_type.pp Get_type.equal + +let add_number () = + let actual = + Get_type.boperator _position T.Plus + (Get_type.integer _position "0") + (Get_type.integer _position "1") + in + let expected = Get_type.(Raw Integer) in + let msg = "Adding integer" in + Alcotest.(check' type_of ~msg ~expected ~actual) + +let add_literal_number () = + let actual = + Get_type.boperator _position T.Plus + (Get_type.literal _position [ T.Text "2" ]) + (Get_type.integer _position "1") + in + let expected = Get_type.(Raw Integer) in + let msg = "A string containing integer is considered as integer" in + Alcotest.(check' type_of ~msg ~expected ~actual) + +let concat_text () = + let actual = + Get_type.boperator _position T.Plus + (Get_type.literal _position [ T.Text "a" ]) + (Get_type.integer _position "1") + in + let expected = Get_type.(Raw String) in + let msg = "Concatenate" in + Alcotest.(check' type_of ~msg ~expected ~actual) + +let test = + ( "Type expression", + [ + Alcotest.test_case "int + int" `Quick add_number; + Alcotest.test_case "'int' + int" `Quick add_literal_number; + Alcotest.test_case "str + int" `Quick concat_text; + ] ) diff --git a/test/qsp_parser_test.ml b/test/qsp_parser_test.ml index 4754a15..ada04d3 100644 --- a/test/qsp_parser_test.ml +++ b/test/qsp_parser_test.ml @@ -4,6 +4,7 @@ let () = Syntax.test; Literals.test; Syntax_error.test; + Get_type.test; Type_of.test; Dead_end.test; Nested_string.test; diff --git a/test/type_of.ml b/test/type_of.ml index d2be5e7..aac928e 100644 --- a/test/type_of.ml +++ b/test/type_of.ml @@ -73,6 +73,8 @@ let wrong_predicate () = }; ] +let concat_text () = _test_instruction {|$a = 'A' + 1|} [] + let test = ( "Typechecking", [ @@ -90,4 +92,5 @@ let test = 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; + Alcotest.test_case "+(int, str)" `Quick concat_text; ] ) |