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