Used the dead-end checker in main analysis

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 ]