From 6fd720c07e3e361932e01bfbdbe4637c8f610649 Mon Sep 17 00:00:00 2001
From: Chimrod <>
Date: Sun, 4 Feb 2024 10:37:04 +0100
Subject: Added a general context for each test

---
 bin/qsp_parser.ml | 58 ++++++++++++++++++++++++++++++++-----------------------
 1 file changed, 34 insertions(+), 24 deletions(-)

(limited to 'bin/qsp_parser.ml')

diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml
index 6d045b8..fef6aac 100644
--- a/bin/qsp_parser.ml
+++ b/bin/qsp_parser.ml
@@ -83,39 +83,43 @@ let checkers : (module Qsp_syntax.S.Analyzer) Lazy.t =
     (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
+    read properly), or until the first syntax error.
+
+    The function update the context (list of errors) passed in arguments. *)
+let parse_location :
+    type context.
+    ctx:ctx ref ->
+    (module Qsp_syntax.S.Analyzer with type context = context) ->
+    context ->
+    Qparser.Lexbuf.t ->
+    Args.filters ->
+    unit =
+ fun ~ctx (module Check) context lexbuf filters ->
   let result =
-    Qparser.Analyzer.parse (module Check) lexbuf
+    Qparser.Analyzer.parse (module Check) lexbuf context
     |> Result.map (fun (_, f) ->
            List.fold_left f ~init:[] ~f:(filter_report filters)
            |> List.sort ~cmp:Report.compare)
   in
   match result with
-  | Ok report -> (
+  | Ok [] -> ()
+  | Ok report ->
       (* Display the result *)
-      match report with
-      | [] -> ctx
-      | _ ->
-          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.fold_left report ~init:ctx ~f:(fun ctx report ->
-              match report.Report.level with
-              | Error -> { ctx with error_nb = succ ctx.error_nb }
-              | Warn -> { ctx with warn_nb = succ ctx.warn_nb }
-              | Debug -> { ctx with debug_nb = succ ctx.debug_nb }))
+      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 with error_nb = succ ctx.error_nb }
-
-let default_ctx = { error_nb = 0; warn_nb = 0; debug_nb = 0 }
+      ctx := { !ctx with error_nb = succ !ctx.error_nb }
 
 let () =
   let file_names, parameters =
@@ -142,11 +146,17 @@ let () =
     Qparser.Lexbuf.from_lexbuf ~reset_line:parameters.reset_line lexer
   in
 
-  let ctx = ref default_ctx in
+  (* Initialize all the checkers before parsing the source *)
+  let (module Check) = Lazy.force checkers in
+  let check_context = Check.initialize () in
+  let ctx = ref { error_nb = 0; warn_nb = 0; debug_nb = 0 } in
+
   let () =
     try
       while true do
-        ctx := parse_location ~ctx:!ctx lexer parameters.filters
+        parse_location ~ctx
+          (module Check)
+          check_context lexer parameters.filters
       done
     with Qparser.Lexer.EOF -> ()
   in
-- 
cgit v1.2.3