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')
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