aboutsummaryrefslogtreecommitdiff
path: root/bin/qsp_parser.ml
diff options
context:
space:
mode:
Diffstat (limited to 'bin/qsp_parser.ml')
-rw-r--r--bin/qsp_parser.ml46
1 files changed, 33 insertions, 13 deletions
diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml
index db07c82..1b2b90c 100644
--- a/bin/qsp_parser.ml
+++ b/bin/qsp_parser.ml
@@ -18,32 +18,40 @@ type ctx = { error_nb : int; warn_nb : int; debug_nb : int }
List all the controls to apply
*)
let available_checks =
- [|
+ [
snd @@ Qsp_syntax.Check.build (module Qsp_syntax.Type_of);
snd @@ Qsp_syntax.Check.build (module Qsp_syntax.Dead_end);
snd @@ Qsp_syntax.Check.build (module Qsp_syntax.Nested_strings);
- |]
+ ]
-let pp_print_module formatter (module A : Qsp_syntax.S.Analyzer) =
+let pp_module formatter (module A : Qsp_syntax.S.Analyzer) =
Format.fprintf formatter "%s" A.identifier;
Format.pp_print_tab formatter ();
+ (match !A.active with
+ | true -> Format.fprintf formatter "*"
+ | false -> Format.fprintf formatter " ");
+ Format.pp_print_tab formatter ();
Format.fprintf formatter "%s" A.description;
()
-let pp_print_modules formatter =
+(** Print all the available modules *)
+let pp_modules formatter =
let max_length =
- Array.fold_left available_checks ~init:0 ~f:(fun l v ->
+ List.fold_left available_checks ~init:0 ~f:(fun l v ->
let (module A : Qsp_syntax.S.Analyzer) =
Qsp_syntax.Check.get_module v
in
max l (String.length A.identifier))
in
- let ll = Array.to_list available_checks in
Format.pp_open_tbox formatter ();
- (* Print the name, left justified, with enougth spaces for the identifier *)
+ (* Print the name, left justified, with enought spaces for the all the
+ identifiers *)
Format.fprintf formatter "%-*s" (max_length + 1) "Name";
+ (* Tab delimiter *)
+ Format.pp_set_tab formatter ();
+ Format.fprintf formatter "Active ";
Format.pp_set_tab formatter ();
Format.fprintf formatter "Description@\n";
@@ -51,21 +59,31 @@ let pp_print_modules formatter =
(Format.pp_print_list
(fun f v ->
let m = Qsp_syntax.Check.get_module v in
- pp_print_module f m)
+ pp_module f m)
~pp_sep:(fun f () -> Format.pp_force_newline f ()))
- ll;
+ available_checks;
Format.pp_close_tbox formatter ();
Format.pp_print_break formatter 0 0
-module Check = Qsp_syntax.Check.Make (struct
- let t = available_checks
-end)
+let checkers : (module Qsp_syntax.S.Analyzer) Lazy.t =
+ lazy
+ (let module Check = Qsp_syntax.Check.Make (struct
+ let t =
+ List.filter available_checks ~f:(fun v ->
+ let (module A : Qsp_syntax.S.Analyzer) =
+ Qsp_syntax.Check.get_module v
+ in
+ !A.active)
+ |> Array.of_list
+ end) in
+ (module Check))
(** Read the source file until getting a report (the whole location has been
read properly), or until the first syntax error.
*)
let parse_location : ctx:ctx -> Qparser.Lexbuf.t -> Args.filters -> ctx =
fun ~ctx lexbuf filters ->
+ let (module Check) = Lazy.force checkers in
let result =
Qparser.Analyzer.parse (module Check) lexbuf
|> Result.map (fun (_, f) ->
@@ -96,7 +114,9 @@ let parse_location : ctx:ctx -> Qparser.Lexbuf.t -> Args.filters -> ctx =
let default_ctx = { error_nb = 0; warn_nb = 0; debug_nb = 0 }
let () =
- let file_names, parameters = Args.parse ~list_tests:pp_print_modules in
+ let file_names, parameters =
+ Args.parse ~modules:available_checks ~list_tests:pp_modules
+ in
let file_name = List.hd file_names in
let ic = Stdlib.open_in_bin file_name in