aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/syntax/get_type.ml36
-rw-r--r--lib/syntax/type_of.ml50
-rw-r--r--test/get_type.ml34
-rw-r--r--test/type_of.ml25
4 files changed, 104 insertions, 41 deletions
diff --git a/lib/syntax/get_type.ml b/lib/syntax/get_type.ml
index 442f49f..b22f53c 100644
--- a/lib/syntax/get_type.ml
+++ b/lib/syntax/get_type.ml
@@ -15,6 +15,10 @@ type t' = t
let v = Fun.id
let get_type : t -> type_of = function Raw r -> r | Variable r -> r
+let map : t -> type_of -> t =
+ fun t type_of ->
+ match t with Raw _ -> Raw type_of | Variable _ -> Variable type_of
+
let get_nature : t -> t -> type_of -> t =
fun t1 t2 type_of ->
match (t1, t2) with
@@ -31,11 +35,33 @@ let ident : (S.pos, 'any) S.variable -> t =
let literal : S.pos -> t T.literal list -> t =
fun pos values ->
ignore pos;
- let init = Raw NumericString in
- List.fold_left values ~init ~f:(fun state -> function
- | T.Text t -> (
- match int_of_string_opt t with Some _ -> state | None -> Raw String)
- | T.Expression t -> t)
+ let init = None in
+ let typed =
+ List.fold_left values ~init ~f:(fun state -> function
+ | T.Text t -> (
+ (* Tranform the type, but keep the information is it’s a raw data
+ or a variable one *)
+ let nature = Option.value ~default:(Raw Integer) state in
+ match (Option.map get_type state, int_of_string_opt t) with
+ | None, Some _
+ | Some Integer, Some _
+ | Some NumericString, Some _
+ | Some Bool, Some _ ->
+ Some (map nature NumericString)
+ | _, _ ->
+ if String.equal "" t then
+ (* If the text is empty, ignore it *)
+ state
+ else Some (map nature String))
+ | T.Expression t -> (
+ let nature = Option.value ~default:(Raw Integer) state in
+ match (Option.map get_type state, get_type t) with
+ | None, Integer | Some NumericString, Integer ->
+ Some (get_nature nature t NumericString)
+ | _ -> Some (map nature String)))
+ in
+ let result = Option.value ~default:(Raw String) typed in
+ result
let uoperator : S.pos -> T.uoperator -> t -> t =
fun pos operator t ->
diff --git a/lib/syntax/type_of.ml b/lib/syntax/type_of.ml
index ee6b314..3c04256 100644
--- a/lib/syntax/type_of.ml
+++ b/lib/syntax/type_of.ml
@@ -190,16 +190,19 @@ module TypedExpression = struct
=
fun pos values type_of ->
ignore type_of;
- let init = ({ pos; empty = true }, []) in
- let result =
- List.fold_left values ~init ~f:(fun (_, report) -> function
+ let init = (true, []) in
+ let empty, report =
+ List.fold_left values ~init ~f:(fun (was_empty, report) -> function
| T.Text t ->
- let empty = String.equal t String.empty in
- ({ pos; empty }, report)
- | T.Expression t -> snd t)
+ let empty_text = String.equal t String.empty in
+ let empty = was_empty && empty_text in
+ (empty, report)
+ | T.Expression (_, t) ->
+ let empty = was_empty && (fst t).empty in
+ let report = List.rev_append (snd t) (snd init) in
+ (empty, report))
in
-
- result
+ ({ pos; empty }, report)
let function_ :
S.pos ->
@@ -334,23 +337,21 @@ module TypedExpression = struct
| 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 =
- match
- Helper.compare_args ~level:Error pos expected (List.rev types)
+ 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 =
+ match
+ Helper.compare_args ~level:Error pos expected (List.rev types)
+ report
+ with
+ | [] ->
+ Helper.compare_args ~strict:true 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)
+ | report -> 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
@@ -448,6 +449,7 @@ module Instruction = struct
let report' = Option.map snd variable.index |> Option.value ~default:[] in
let report = List.rev_append report' report in
+
match
( right_expression.empty,
op,
diff --git a/test/get_type.ml b/test/get_type.ml
index d7bb333..627e2a8 100644
--- a/test/get_type.ml
+++ b/test/get_type.ml
@@ -36,10 +36,44 @@ let concat_text () =
let msg = "Concatenate" in
Alcotest.(check' type_of ~msg ~expected ~actual)
+let literal_1 () =
+ let actual =
+ Get_type.literal _position [ T.Expression (Get_type.Raw Integer) ]
+ and expected = Get_type.(Raw NumericString) in
+ let msg = "" in
+ Alcotest.(check' type_of ~msg ~expected ~actual)
+
+let literal_2 () =
+ let actual =
+ Get_type.literal _position
+ Get_type.[ T.Text "1"; T.Expression (Raw Integer) ]
+ and expected = Get_type.(Raw NumericString) in
+ let msg = "" in
+ Alcotest.(check' type_of ~msg ~expected ~actual)
+
+let literal_3 () =
+ let actual =
+ Get_type.literal _position
+ Get_type.[ T.Text "b"; T.Expression (Raw Integer) ]
+ and expected = Get_type.(Raw String) in
+ let msg = "" in
+ Alcotest.(check' type_of ~msg ~expected ~actual)
+
+let literal_4 () =
+ let actual =
+ Get_type.literal _position [ T.Expression (Get_type.Variable Integer) ]
+ and expected = Get_type.(Variable NumericString) in
+ let msg = "" 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;
+ Alcotest.test_case "<<int>>" `Quick literal_1;
+ Alcotest.test_case "1<<int>>" `Quick literal_2;
+ Alcotest.test_case "b<<int>>" `Quick literal_3;
+ Alcotest.test_case "<<$int>>" `Quick literal_4;
] )
diff --git a/test/type_of.ml b/test/type_of.ml
index e5f7f9b..53d01bd 100644
--- a/test/type_of.ml
+++ b/test/type_of.ml
@@ -22,25 +22,26 @@ let message' level =
};
]
+let integer_as_string =
+ [
+ Qsp_syntax.Report.
+ {
+ level = Warn;
+ loc = _position;
+ message = "The type Integer is expected but got Integer as String";
+ };
+ ]
+
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|} (message Warn)
let type_mismatch2 () = _test_instruction {|abc[''] = $Var|} (message Warn)
+let type_conversion () = _test_instruction {|abc = '123'|} integer_as_string
-let type_conversion () =
- _test_instruction {|abc = '123'|}
- [
- {
- level = Warn;
- loc = _position;
- message = "The type Integer is expected but got Integer as String";
- };
- ]
-
-(** This expression is not considered as a string *)
-let type_conversion' () = _test_instruction {|abc = '<<123>>'|} []
+let type_conversion' () =
+ _test_instruction {|abc = '<<123>>'|} integer_as_string
let type_comparaison () = _test_instruction {|(abc = '123')|} []
let type_comparaison_eq () = _test_instruction {|($abc = 123)|} (message Warn)