qsp_parser/test/dead_end.ml

module Dead_end = Qsp_syntax.Dead_end
module S = Qsp_syntax.S

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)

(** This one is OK because act provide a solution in any case *)
let ok () =
  _test_instruction {|
if 0:
	act '': gt ''
	if 1:
		act '': gt ''
	end
end
  |}
    []

(** Ignore top level dead end*)
let toplevel () =
  _test_instruction {|
act 1:
  act '': gt ''
end

if 1: act '': gt ''

  |} []

let else_branch () =
  _test_instruction
    {|
if 0:
	if 1:
		act '': gt ''
	else
		act '': ''
	end
end
  |}
    [
      {
        level = Warn;
        loc = _position;
        message = "Possible dead end (unmatched path)";
      };
    ]

let elseif_branch () =
  _test_instruction
    {|
if 0:
	if 1:
		act '': ''
    elseif 0:
		act '': gt ''
	end
end
  |}
    [
      {
        level = Debug;
        loc = _position;
        message = "Possible dead end (no else fallback)";
      };
    ]

let missing_else () =
  _test_instruction {|
if 0:
	if 1: act '': gt ''
end
  |}
    [
      {
        level = Debug;
        loc = _position;
        message = "Possible dead end (no else fallback)";
      };
    ]

let nothing () = _test_instruction {|
if 0:
	if 1: 0
end
  |} []

let test =
  ( "Dead end",
    [
      Alcotest.test_case "No dead_end" `Quick ok;
      Alcotest.test_case "top level" `Quick toplevel;
      Alcotest.test_case "Else branch" `Quick else_branch;
      Alcotest.test_case "ElseIf branch" `Quick elseif_branch;
      Alcotest.test_case "Missing else" `Quick missing_else;
      Alcotest.test_case "nothing" `Quick nothing;
    ] )