From d7a13b0e5d6e746993e67a291376bd79766e0ed1 Mon Sep 17 00:00:00 2001
From: Chimrod <>
Date: Sat, 3 Feb 2024 17:42:16 +0100
Subject: Added a new check to ensure that every call to another location
 points to an existing one

---
 bin/qsp_parser.ml | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

(limited to 'bin')

diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml
index fef6aac..30c0ac0 100644
--- a/bin/qsp_parser.ml
+++ b/bin/qsp_parser.ml
@@ -22,6 +22,7 @@ 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);
+    snd @@ Qsp_syntax.Check.build (module Qsp_syntax.Locations);
   ]
 
 let pp_module formatter (module A : Qsp_syntax.S.Analyzer) =
@@ -133,6 +134,12 @@ let () =
   let lexer, parameters =
     match Filename.extension file_name with
     | ".qsrc" ->
+        (* Deactivate the tests which only applies to a global file *)
+        List.iter available_checks ~f:(fun t ->
+            let (module C : Qsp_syntax.S.Analyzer) =
+              Qsp_syntax.Check.get_module t
+            in
+            if C.is_global then C.active := false);
         (* 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,
@@ -161,6 +168,17 @@ let () =
     with Qparser.Lexer.EOF -> ()
   in
 
+  (* If the parsing was global, extract the result for the whole test *)
+  let global_report = Check.finalize check_context in
+  List.iter global_report ~f:(fun (f_name, report) ->
+      Format.fprintf Format.std_formatter "Location@ %s@;@[%a@]@." f_name
+        Report.pp 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 });
+
   match (!ctx.error_nb, !ctx.warn_nb) with
   | 0, 0 -> (
       print_endline "No errors found";
-- 
cgit v1.2.3