qsp_parser/test/make_checkTest.ml

(** 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