Added dynamic check mecanismHEADmaster

1 files changed, 99 insertions, 33 deletions

diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml
index a8ee457..f928d24 100644
--- a/bin/qsp_parser.ml
+++ b/bin/qsp_parser.ml
@@ -14,17 +14,27 @@ let filter_report : Args.filters -> Report.t list -> Report.t -> Report.t list =
 
 type ctx = { error_nb : int; warn_nb : int; debug_nb : int; fatal_error : bool }
 
+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 =
   [
-    snd @@ Qsp_syntax.Catalog.build (module Qsp_checks.Type_of);
-    snd @@ Qsp_syntax.Catalog.build (module Qsp_checks.Dead_end);
-    snd @@ Qsp_syntax.Catalog.build (module Qsp_checks.Nested_strings);
-    snd @@ Qsp_syntax.Catalog.build (module Qsp_checks.Locations);
-    snd @@ Qsp_syntax.Catalog.build (module Qsp_checks.Dup_test);
-    snd @@ Qsp_syntax.Catalog.build (module Qsp_checks.Write_only);
+    Qsp_syntax.Catalog.build ~context_id:dynamic_context_id
+      (module Qsp_checks.Dynamics);
+    Qsp_syntax.Catalog.build (module Qsp_checks.Type_of);
+    Qsp_syntax.Catalog.build (module Qsp_checks.Dead_end);
+    Qsp_syntax.Catalog.build (module Qsp_checks.Nested_strings);
+    Qsp_syntax.Catalog.build (module Qsp_checks.Locations);
+    Qsp_syntax.Catalog.build (module Qsp_checks.Dup_test);
+    Qsp_syntax.Catalog.build (module Qsp_checks.Write_only);
   ]
 
 let pp_module formatter (module A : Qsp_syntax.S.Analyzer) =
@@ -72,7 +82,10 @@ let pp_modules formatter =
 
     The expression is declared lazy in order to be sure to apply the filters
     from the command line before. *)
-let checkers : (module Qsp_syntax.S.Analyzer) Lazy.t =
+let checkers :
+    (module Qsp_syntax.S.Analyzer
+       with type context = Qsp_checks.Check.result array)
+    Lazy.t =
   lazy
     (let module Check = Qsp_checks.Check.Make (struct
        let t =
@@ -85,44 +98,94 @@ let checkers : (module Qsp_syntax.S.Analyzer) Lazy.t =
      end) in
     (module Check))
 
+let display_result :
+    ctx:ctx ref ->
+    Qparser.Lexbuf.t ->
+    Args.filters ->
+    (Report.t list, Report.t) result ->
+    unit =
+ fun ~ctx lexbuf filters result ->
+  match result with
+  | Error e ->
+      (* Syntax error, we haven’t been able to run the test *)
+      let start_position, _ = Qparser.Lexbuf.positions lexbuf in
+      Format.fprintf Format.std_formatter "Location@ %s@;@[%a]@."
+        start_position.Lexing.pos_fname Report.pp e;
+      ctx := { !ctx with error_nb = succ !ctx.error_nb; fatal_error = true }
+  | Ok report -> (
+      let report =
+        List.fold_left report ~init:[] ~f:(filter_report filters)
+        |> List.sort ~cmp:Report.compare
+      in
+      match report with
+      | [] -> ()
+      | _ ->
+          (* Display the result *)
+          let start_position, _ = Qparser.Lexbuf.positions lexbuf in
+          Format.fprintf Format.std_formatter "Location@ %s@;@[%a@]@."
+            start_position.Lexing.pos_fname Report.pp_result report;
+
+          List.iter report ~f:(fun report ->
+              match report.Report.level with
+              | Error -> ctx := { !ctx with error_nb = succ !ctx.error_nb }
+              | Warn -> ctx := { !ctx with warn_nb = succ !ctx.warn_nb }
+              | Debug -> ctx := { !ctx with debug_nb = succ !ctx.debug_nb }))
+
 (** Read the source file until getting a report (the whole location has been
     read properly), or until the first syntax error.
 
     The function update the context (list of errors) passed in arguments. *)
-let parse_location : type context.
+let parse_location :
     ctx:ctx ref ->
-    (module Qsp_syntax.S.Analyzer with type context = context) ->
-    context ->
+    (module Qsp_syntax.S.Analyzer
+       with type context = Qsp_checks.Check.result array) ->
+    Qsp_checks.Check.result array ->
     Qparser.Lexbuf.t ->
     Args.filters ->
     unit =
  fun ~ctx (module Check) context lexbuf filters ->
   let result =
-    Qparser.Analyzer.parse (module Check) lexbuf context
-    |> Result.map (fun f ->
-           List.fold_left f.Qparser.Analyzer.report ~init:[]
-             ~f:(filter_report filters)
-           |> List.sort ~cmp:Report.compare)
+    Qparser.Analyzer.parse
+      (module Check)
+      Qparser.Analyzer.Location lexbuf context
   in
-  match result with
-  | Ok [] -> ()
-  | Ok report ->
-      (* Display the result *)
-      let start_position, _ = Qparser.Lexbuf.positions lexbuf in
-      Format.fprintf Format.std_formatter "Location@ %s@;@[%a@]@."
-        start_position.Lexing.pos_fname Report.pp_result report;
 
-      List.iter report ~f:(fun report ->
-          match report.Report.level with
-          | Error -> ctx := { !ctx with error_nb = succ !ctx.error_nb }
-          | Warn -> ctx := { !ctx with warn_nb = succ !ctx.warn_nb }
-          | Debug -> ctx := { !ctx with debug_nb = succ !ctx.debug_nb })
-  | Error e ->
-      (* Syntax error, we haven’t been able to run the test *)
-      let start_position, _ = Qparser.Lexbuf.positions lexbuf in
-      Format.fprintf Format.std_formatter "Location@ %s@;@[%a]@."
-        start_position.Lexing.pos_fname Report.pp e;
-      ctx := { !ctx with error_nb = succ !ctx.error_nb; fatal_error = true }
+  (* 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
+  in
+  display_result ~ctx lexbuf filters result_with_dynamics
 
 let () =
   let file_names, parameters =
@@ -144,6 +207,9 @@ let () =
               Qsp_checks.Check.get_module t
             in
             if C.is_global && !C.active then C.active := false);
+
+        Qsp_checks.Dynamics.active := true;
+
         (* The source file are in UTF-8, and we can use the file line number as
            we have only a single location. *)
         ( Sedlexing.Utf8.from_channel ic,