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
|
open StdLabels
module Report = Qsp_syntax.Report
let input_files = ref []
let usage =
Printf.sprintf "%s input_file" (Filename.basename Sys.executable_name)
let anon_fun filename = input_files := filename :: !input_files
let level_value = ref None
let reset_line = ref false
let interractive () = ()
type filters = { level : Report.level option }
type t = { reset_line : bool; filters : filters }
(** All the arguments given from the command line *)
let level : string -> unit =
fun str_level ->
match Report.level_of_string str_level with
| Ok level_ -> level_value := Some level_
| Error e ->
print_endline e;
exit 1
let disable_module modules identifier =
let identifier =
String.sub identifier ~pos:1 ~len:(String.length identifier - 1)
in
List.iter modules ~f:(fun t ->
let (module C : Qsp_syntax.S.Analyzer) = Qsp_syntax.Check.get_module t in
if String.equal C.identifier identifier then C.active := false)
let enable_module modules identifier =
let identifier =
String.sub identifier ~pos:1 ~len:(String.length identifier - 1)
in
List.iter modules ~f:(fun t ->
let (module C : Qsp_syntax.S.Analyzer) = Qsp_syntax.Check.get_module t in
if String.equal C.identifier identifier then C.active := true)
let speclist printer =
let common_arguments =
[
( "--version",
Arg.Unit
(fun () ->
Printf.printf "Version %s\n" Tools.Git_hash.revision;
exit 0),
"\tDisplay the version of the application and exit" );
( "--list-tests",
Arg.Unit
(fun () ->
printer Format.std_formatter;
exit 0),
"\tPrint all the available tests then exit" );
( "--level",
Arg.String level,
"\tFilter with this message level [debug, warn, error]" );
( "--global",
Arg.Set reset_line,
"\tEach line is refered from the begining of the file and not the \
location" );
("-<test>", Arg.Unit (fun () -> ()), "\tDisable this test");
("+<test>", Arg.Unit (fun () -> ()), "\tEnable this test");
]
and windows_arguments =
match Sys.os_type with
| "Win32" ->
[ ("--no-prompt", Arg.Unit interractive, "\tDeprecated. Does nothing") ]
| _ -> []
in
common_arguments @ windows_arguments
let parse :
modules:Qsp_syntax.Check.t list ->
list_tests:(Format.formatter -> unit) ->
string list * t =
fun ~modules ~list_tests ->
let speclist = speclist list_tests in
let speclist =
let r = ref speclist in
for i = 1 to pred (Array.length Sys.argv) do
let s = Sys.argv.(i) in
if
s.[0] = '-'
&& String.length s > 1
&& s.[1] != '-'
&& (not (String.equal s "--help"))
&& (not (String.equal s "-help"))
&& not (List.exists !r ~f:(fun (s', _, _) -> String.equal s s'))
then
r :=
( s,
Arg.Unit (fun () -> disable_module modules s),
"\tDisable this test" )
:: !r
else if s.[0] = '+' then enable_module modules s
done;
!r
in
let () = Arg.parse (Arg.align speclist) anon_fun usage in
match !input_files with
| [] ->
Arg.usage (Arg.align speclist) usage;
prerr_endline "";
prerr_endline "Error, you should provide at least one file to parse.";
exit 1
| _ ->
let filters = { level = !level_value } in
(!input_files, { reset_line = !reset_line; filters })
|
