(** 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 : 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 Qparser.Analyzer.result, t) result = fun ?context content -> let lexing = Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf in let context = Option.value context ~default:(Check.initialize ()) in Qparser.Analyzer.parse (module Check) lexing context let get_report : (Check.Location.t Qparser.Analyzer.result, Qsp_syntax.Report.t) result -> Qsp_syntax.Report.t list = function | Ok v -> v.report | Error _ -> failwith "Error" let _test_instruction : string -> 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) (** 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