diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/dead_end.ml | 136 | ||||
| -rw-r--r-- | test/qsp_parser_test.ml | 3 | 
2 files changed, 138 insertions, 1 deletions
| diff --git a/test/dead_end.ml b/test/dead_end.ml new file mode 100644 index 0000000..9cce62d --- /dev/null +++ b/test/dead_end.ml @@ -0,0 +1,136 @@ +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; +    ] ) diff --git a/test/qsp_parser_test.ml b/test/qsp_parser_test.ml index cbbe91e..8629175 100644 --- a/test/qsp_parser_test.ml +++ b/test/qsp_parser_test.ml @@ -1 +1,2 @@ -let () = Alcotest.run "qsp_parser" [ Syntax.test; Syntax_error.test ] +let () = +  Alcotest.run "qsp_parser" [ Syntax.test; Syntax_error.test; Dead_end.test ] | 
