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; ] )