diff options
Diffstat (limited to 'bin/qsp_parser.ml')
| -rw-r--r-- | bin/qsp_parser.ml | 89 |
1 files changed, 6 insertions, 83 deletions
diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml index 7ec3eff..f389406 100644 --- a/bin/qsp_parser.ml +++ b/bin/qsp_parser.ml @@ -18,25 +18,6 @@ module type T = sig include module type of Qsp_checks.Dynamics end -(** Witness used to extract the values in the module Qsp_checks.Dynamics during - the parsing. *) -let dynamic_context_id : Qsp_checks.Dynamics.context Type.Id.t = Type.Id.make () - -(* - List all the controls to apply - *) -let available_checks = - [ - Qsp_syntax.Identifier.build ~context_id:dynamic_context_id - (module Qsp_checks.Dynamics); - Qsp_syntax.Identifier.build (module Qsp_checks.Type_of); - Qsp_syntax.Identifier.build (module Qsp_checks.Dead_end); - Qsp_syntax.Identifier.build (module Qsp_checks.Nested_strings); - Qsp_syntax.Identifier.build (module Qsp_checks.Locations); - Qsp_syntax.Identifier.build (module Qsp_checks.Dup_test); - Qsp_syntax.Identifier.build (module Qsp_checks.Write_only); - ] - let pp_module formatter (module A : Qsp_syntax.Analyzer.T) = Format.fprintf formatter "%s" A.identifier; Format.pp_print_tab formatter (); @@ -50,7 +31,7 @@ let pp_module formatter (module A : Qsp_syntax.Analyzer.T) = (** Print all the available modules *) let pp_modules formatter = let max_length = - List.fold_left available_checks ~init:0 ~f:(fun l v -> + List.fold_left Checklist.available_checks ~init:0 ~f:(fun l v -> let (module A : Qsp_syntax.Analyzer.T) = Qsp_syntax.Identifier.get_module v in @@ -74,30 +55,10 @@ let pp_modules formatter = let m = Qsp_syntax.Identifier.get_module v in pp_module f m) ~pp_sep:(fun f () -> Format.pp_force_newline f ())) - available_checks; + Checklist.available_checks; Format.pp_close_tbox formatter (); Format.pp_print_break formatter 0 0 -(** Get all the tests to apply. - - The expression is declared lazy in order to be sure to apply the filters - from the command line before. *) -let checkers : - (module Qsp_syntax.Analyzer.T - with type context = Qsp_checks.Check.result array) - Lazy.t = - lazy - (let module Check = Qsp_checks.Check.Make (struct - let t = - List.filter available_checks ~f:(fun v -> - let (module A : Qsp_syntax.Analyzer.T) = - Qsp_syntax.Identifier.get_module v - in - !A.active) - |> Array.of_list - end) in - (module Check)) - let pp_report : (Format.formatter -> 'a -> unit) -> Qparser.Lexbuf.t -> @@ -151,52 +112,14 @@ let parse_location : Args.filters -> unit = fun ~ctx (module Check) context lexbuf filters -> - let result = - Qparser.Analyzer.parse - (module Check) - Qparser.Analyzer.Location lexbuf context - in - - (* Also analyse eache dynamic string identified in the module *) let result_with_dynamics = - Result.map - (fun r -> - match Qsp_checks.Check.get dynamic_context_id (Array.get context 0) with - | None -> r.Qparser.Analyzer.report - | Some dyn_context -> - let seq : Qsp_checks.Dynamics.text Seq.t = - Qsp_checks.Dynamics.dynamics_string dyn_context - in - Seq.fold_left - (fun r content -> - let text = content.Qsp_checks.Dynamics.content ^ "\n" in - - let lexing = - Sedlexing.Latin1.from_string text - |> Qparser.Lexbuf.from_lexbuf - ~position:(fst content.Qsp_checks.Dynamics.position) - in - - let dyn_report = - Qparser.Analyzer.parse - (module Check) - Qparser.Analyzer.Dynamic lexing context - in - match dyn_report with - | Error e -> - (* Syntax error are not blocking here, but are transformed - into check error *) - e :: r - | Ok dyn_ok_reports -> - dyn_ok_reports.Qparser.Analyzer.report @ r) - r.Qparser.Analyzer.report seq) - result + Checklist.get_report (module Check) context lexbuf in display_result ~ctx lexbuf filters result_with_dynamics let () = let file_names, parameters = - Args.parse ~modules:available_checks ~list_tests:pp_modules + Args.parse ~modules:Checklist.available_checks ~list_tests:pp_modules in let file_name = List.filter ~f:(fun name -> name.[0] != '+') file_names |> List.hd @@ -209,7 +132,7 @@ let () = match Filename.extension file_name with | ".qsrc" -> (* Deactivate the tests which only applies to a global file *) - List.iter available_checks ~f:(fun t -> + List.iter Checklist.available_checks ~f:(fun t -> let (module C : Qsp_syntax.Analyzer.T) = Qsp_syntax.Identifier.get_module t in @@ -231,7 +154,7 @@ let () = in (* Initialize all the checkers before parsing the source *) - let (module Check) = Lazy.force checkers in + let (module Check) = Lazy.force Checklist.checkers in let check_context = Check.initialize () in let ctx = ref { error_nb = 0; warn_nb = 0; debug_nb = 0; fatal_error = false } |