diff options
Diffstat (limited to 'bin')
| -rw-r--r-- | bin/args.ml | 17 | ||||
| -rw-r--r-- | bin/args.mli | 2 | ||||
| -rw-r--r-- | bin/qsp_parser.ml | 49 |
3 files changed, 56 insertions, 12 deletions
diff --git a/bin/args.ml b/bin/args.ml index 27c5a70..0021b34 100644 --- a/bin/args.ml +++ b/bin/args.ml @@ -23,7 +23,7 @@ let level : string -> unit = print_endline e; exit 1 -let speclist = +let speclist printer = let common_arguments = [ ( "--version", @@ -32,7 +32,15 @@ let speclist = Printf.printf "Version %s\n" Tools.Git_hash.revision; exit 0), "\tDisplay the version of the application and exit" ); - ("--level", Arg.String level, "\tMessage level [debug, warn, error]"); + ( "--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 \ @@ -46,8 +54,9 @@ let speclist = in common_arguments @ windows_arguments -let parse : unit -> string list * t = - fun () -> +let parse : list_tests:(Format.formatter -> unit) -> string list * t = + fun ~list_tests -> + let speclist = speclist list_tests in let () = Arg.parse (Arg.align speclist) anon_fun usage in match !input_files with diff --git a/bin/args.mli b/bin/args.mli index 5231cae..cffd0d0 100644 --- a/bin/args.mli +++ b/bin/args.mli @@ -3,4 +3,4 @@ type filters = { level : Qsp_syntax.Report.level option } type t = { reset_line : bool; filters : filters } (** All the arguments given from the command line *) -val parse : unit -> string list * t +val parse : list_tests:(Format.formatter -> unit) -> string list * t diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml index f147a95..db07c82 100644 --- a/bin/qsp_parser.ml +++ b/bin/qsp_parser.ml @@ -17,13 +17,48 @@ 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) = + Format.fprintf formatter "%s" A.identifier; + Format.pp_print_tab formatter (); + Format.fprintf formatter "%s" A.description; + () + +let pp_print_modules formatter = + let max_length = + Array.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 *) + Format.fprintf formatter "%-*s" (max_length + 1) "Name"; + Format.pp_set_tab formatter (); + Format.fprintf formatter "Description@\n"; + + Format.fprintf formatter "%a" + (Format.pp_print_list + (fun f v -> + let m = Qsp_syntax.Check.get_module v in + pp_print_module f m) + ~pp_sep:(fun f () -> Format.pp_force_newline f ())) + ll; + Format.pp_close_tbox formatter (); + Format.pp_print_break formatter 0 0 + module Check = Qsp_syntax.Check.Make (struct - let t = - [| - 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 t = available_checks end) (** Read the source file until getting a report (the whole location has been @@ -61,7 +96,7 @@ 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 () in + let file_names, parameters = Args.parse ~list_tests:pp_print_modules in let file_name = List.hd file_names in let ic = Stdlib.open_in_bin file_name in |