blob: 9cce62d9d9538a0ff811ccde107f42601298dcfd (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
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;
] )
|
