From 6ada3862d96f82e44b3b19dd84d08cbb8c6a6006 Mon Sep 17 00:00:00 2001
From: Chimrod <>
Date: Sat, 4 Nov 2023 17:16:16 +0100
Subject: Allow test to be enabled or disabled by command line

---
 bin/qsp_parser.ml | 46 +++++++++++++++++++++++++++++++++-------------
 1 file changed, 33 insertions(+), 13 deletions(-)

(limited to 'bin/qsp_parser.ml')

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
-- 
cgit v1.2.3