diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/dead_end.ml | 43 | ||||
| -rw-r--r-- | test/make_checkTest.ml | 47 | ||||
| -rw-r--r-- | test/qsp_parser_test.ml | 3 | ||||
| -rw-r--r-- | test/type_of.ml | 58 |
4 files changed, 109 insertions, 42 deletions
diff --git a/test/dead_end.ml b/test/dead_end.ml index 9cce62d..f91680f 100644 --- a/test/dead_end.ml +++ b/test/dead_end.ml @@ -1,48 +1,9 @@ -module Dead_end = Qsp_syntax.Dead_end -module S = Qsp_syntax.S +module Check = Make_checkTest.M (Qsp_syntax.Dead_end) let _position = (Lexing.dummy_pos, Lexing.dummy_pos) -let pp_pos = Qsp_syntax.Report.pp_pos - -type pos = S.pos - -let equal_pos : pos -> pos -> bool = fun _ _ -> true - -type t = Qsp_syntax.Report.t = { - level : Qsp_syntax.Report.level; - loc : pos; - message : string; -} -[@@deriving show, eq] - -let report : Qsp_syntax.Report.t list Alcotest.testable = - Alcotest.list @@ Alcotest.testable Qsp_syntax.Report.pp equal - -let parse : - string -> - (Dead_end.Location.t * Qsp_syntax.Report.t list, Qsp_syntax.Report.t) result - = - fun content -> - let lexing = - Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf - in - Qparser.Analyzer.parse (module Dead_end) lexing - -let get_report : - (Dead_end.Location.t * Qsp_syntax.Report.t list, Qsp_syntax.Report.t) result -> - Qsp_syntax.Report.t list = function - | Ok (_, report) -> report - | Error _ -> failwith "Error" let _test_instruction : string -> Qsp_syntax.Report.t list -> unit = - fun literal expected -> - let _location = Printf.sprintf {|# Location -%s -------- |} literal in - let actual = get_report @@ parse _location and msg = literal in - - Alcotest.(check' report ~msg ~expected ~actual) - + Check._test_instruction (** This one is OK because act provide a solution in any case *) let ok () = _test_instruction {| diff --git a/test/make_checkTest.ml b/test/make_checkTest.ml new file mode 100644 index 0000000..308d309 --- /dev/null +++ b/test/make_checkTest.ml @@ -0,0 +1,47 @@ +let _position = (Lexing.dummy_pos, Lexing.dummy_pos) + +(** Build a parser for a specific check module *) +module M (Check : Qsp_syntax.S.Analyzer) = struct + module S = Qsp_syntax.S + + let pp_pos = Qsp_syntax.Report.pp_pos + + type pos = S.pos + + let equal_pos : pos -> pos -> bool = fun _ _ -> true + + type t = Qsp_syntax.Report.t = { + level : Qsp_syntax.Report.level; + loc : pos; + message : string; + } + [@@deriving show, eq] + + let report : Qsp_syntax.Report.t list Alcotest.testable = + Alcotest.list @@ Alcotest.testable Qsp_syntax.Report.pp equal + + let parse : + string -> + (Check.Location.t * Qsp_syntax.Report.t list, Qsp_syntax.Report.t) result + = + fun content -> + let lexing = + Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf + in + Qparser.Analyzer.parse (module Check) lexing + + let get_report : + (Check.Location.t * Qsp_syntax.Report.t list, Qsp_syntax.Report.t) result -> + Qsp_syntax.Report.t list = function + | Ok (_, report) -> report + | Error _ -> failwith "Error" + + let _test_instruction : string -> Qsp_syntax.Report.t list -> unit = + fun literal expected -> + let _location = Printf.sprintf {|# Location +%s +------- |} literal in + let actual = get_report @@ parse _location and msg = literal in + + Alcotest.(check' report ~msg ~expected ~actual) +end diff --git a/test/qsp_parser_test.ml b/test/qsp_parser_test.ml index 8629175..0828e22 100644 --- a/test/qsp_parser_test.ml +++ b/test/qsp_parser_test.ml @@ -1,2 +1,3 @@ let () = - Alcotest.run "qsp_parser" [ Syntax.test; Syntax_error.test; Dead_end.test ] + Alcotest.run "qsp_parser" + [ Syntax.test; Syntax_error.test; Type_of.test; Dead_end.test ] diff --git a/test/type_of.ml b/test/type_of.ml new file mode 100644 index 0000000..18aae1f --- /dev/null +++ b/test/type_of.ml @@ -0,0 +1,58 @@ +module Check = Make_checkTest.M (Qsp_syntax.Type_of) + +let _position = (Lexing.dummy_pos, Lexing.dummy_pos) + +let _test_instruction : string -> Qsp_syntax.Report.t list -> unit = + Check._test_instruction + +let type_mismatch () = + _test_instruction {|abc = 'ABC'|} + [ + { + level = Error; + loc = _position; + message = "The type Integer is expected but got String"; + }; + ] + +let type_conversion () = + _test_instruction {|abc = '123'|} + [ + { + level = Debug; + loc = _position; + message = "The type Integer is expected but got Integer as String"; + }; + ] + +let type_comparaison () = _test_instruction {|(abc = '123')|} [] + +let type_comparaison_mismatch () = + _test_instruction {|(abc = 'ABC')|} + [ + { + level = Warn; + loc = _position; + message = "The type String is expected but got Integer"; + }; + ] + +let wrong_predicate () = + _test_instruction {| if $var and 1: 0 |} + [ + { + level = Warn; + loc = _position; + message = "The type Bool is expected but got String"; + }; + ] + +let test = + ( "Typechecking", + [ + Alcotest.test_case "Assign" `Quick type_mismatch; + Alcotest.test_case "Conversion" `Quick type_conversion; + Alcotest.test_case "Comparaison" `Quick type_comparaison; + Alcotest.test_case "Comparaison Mismatch" `Quick type_comparaison_mismatch; + Alcotest.test_case "Wrong predicate" `Quick wrong_predicate; + ] ) |