diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/location.ml | 28 | ||||
| -rw-r--r-- | test/make_checkTest.ml | 39 | ||||
| -rw-r--r-- | test/qsp_parser_test.ml | 1 | ||||
| -rw-r--r-- | test/syntax.ml | 5 |
4 files changed, 63 insertions, 10 deletions
diff --git a/test/location.ml b/test/location.ml new file mode 100644 index 0000000..5072164 --- /dev/null +++ b/test/location.ml @@ -0,0 +1,28 @@ +module Check = Make_checkTest.M (Qsp_syntax.Locations) + +let _position = (Lexing.dummy_pos, Lexing.dummy_pos) + +let error_message = + [ + ( "Location", + Check. + { + level = Error; + loc = _position; + message = "The location unknown_place does not exists"; + } ); + ] + +let ok () = Check.global_check "gt 'location'" [] +let ok_upper () = Check.global_check "gt 'LOCATION'" [] +let missing_gt () = Check.global_check "gt 'unknown_place'" error_message +let missing_gs () = Check.global_check "gs 'unknown_place'" error_message + +let test = + ( "Locations", + [ + Alcotest.test_case "Ok" `Quick ok; + Alcotest.test_case "Ok upper" `Quick ok_upper; + Alcotest.test_case "Missing GT" `Quick missing_gt; + Alcotest.test_case "Missing GS" `Quick missing_gs; + ] ) diff --git a/test/make_checkTest.ml b/test/make_checkTest.ml index d428b45..d3ad358 100644 --- a/test/make_checkTest.ml +++ b/test/make_checkTest.ml @@ -15,27 +15,32 @@ module M (Check : Qsp_syntax.S.Analyzer) = struct } [@@deriving show, eq] - let report : Qsp_syntax.Report.t list Alcotest.testable = + let report : t list Alcotest.testable = Alcotest.list @@ Alcotest.testable Qsp_syntax.Report.pp equal + let report_global : (string * t) list Alcotest.testable = + Alcotest.list + @@ Alcotest.pair Alcotest.string + (Alcotest.testable Qsp_syntax.Report.pp equal) + let parse : + ?context:Check.context -> string -> - (Check.Location.t * Qsp_syntax.Report.t list, Qsp_syntax.Report.t) result - = - fun content -> + (Check.Location.t Qparser.Analyzer.result, t) result = + fun ?context content -> let lexing = Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf in - let context = Check.initialize () in + let context = Option.value context ~default:(Check.initialize ()) in Qparser.Analyzer.parse (module Check) lexing context let get_report : - (Check.Location.t * Qsp_syntax.Report.t list, Qsp_syntax.Report.t) result -> + (Check.Location.t Qparser.Analyzer.result, Qsp_syntax.Report.t) result -> Qsp_syntax.Report.t list = function - | Ok (_, report) -> report + | Ok v -> v.report | Error _ -> failwith "Error" - let _test_instruction : string -> Qsp_syntax.Report.t list -> unit = + let _test_instruction : string -> t list -> unit = fun literal expected -> let _location = Printf.sprintf {|# Location %s @@ -43,4 +48,22 @@ module M (Check : Qsp_syntax.S.Analyzer) = struct let actual = get_report @@ parse _location and msg = literal in Alcotest.(check' report ~msg ~expected ~actual) + + (** Run a test over the whole file. + The parsing of the content shall not report any error. + *) + let global_check : string -> (string * t) list -> unit = + fun literal expected -> + let _location = Printf.sprintf {|# Location +%s +------- |} literal in + let context = Check.initialize () in + let actual = get_report @@ parse ~context _location in + let () = + Alcotest.( + check' report ~msg:"Error reported during parsing" ~expected:[] ~actual) + in + let msg = literal in + let actual = Check.finalize context in + Alcotest.(check' report_global ~msg ~expected ~actual) end diff --git a/test/qsp_parser_test.ml b/test/qsp_parser_test.ml index a86df13..609da3f 100644 --- a/test/qsp_parser_test.ml +++ b/test/qsp_parser_test.ml @@ -7,4 +7,5 @@ let () = Type_of.test; Dead_end.test; Nested_string.test; + Location.test; ] diff --git a/test/syntax.ml b/test/syntax.ml index 87fe2ab..aa3eecb 100644 --- a/test/syntax.ml +++ b/test/syntax.ml @@ -29,10 +29,11 @@ let parse : string -> (S.pos location, Qsp_syntax.Report.t) result = in let context = Parser.initialize () in Qparser.Analyzer.parse (module Parser) lexing context - |> Result.map (fun (location, _report) -> + |> Result.map (fun v -> (* Uncatched excteptions here, but we are in the tests… If it’s fail here I have an error in the code. *) - Array.get location 0 |> Check.get location_id |> Option.get) + Array.get v.Qparser.Analyzer.content 0 + |> Check.get location_id |> Option.get) let location : S.pos location Alcotest.testable = let equal = equal_location (fun _ _ -> true) in |