Merge branch 'topic/489' into 'master'

GNATCheckWorker: make JSON instances object distinct from diagnostics

Closes #521

See merge request eng/libadalang/langkit-query-language!525

Author: thvnx

lkql_checker/doc/gnatcheck_rm/using_gnatcheck.rst

@@ -462,9 +462,9 @@ described in the following paragraph).
 
 By default, GNATcheck will look for a ``rules.lkql`` file besides the specified
 project file if any. If one is found and no other rule configuration has been
-provided (either through the LKQL --rule-file option, or by the now deprecated
-legacy -rules options), GNATcheck will load the rule configuration file as if
-it was provided by the --rule-file option.
+provided (either through the LKQL ``--rule-file`` option, or by the now
+deprecated legacy ``-rules`` options), GNATcheck will load the rule
+configuration file as if it was provided by the ``--rule-file`` option.
 
 .. note::
 
@@ -485,7 +485,7 @@ string, or the list of strings type, as shown in the simple example below:
     Forbidden_Attributes: {Forbidden: ["GNAT"], Allowed: ["First", "Last"]}
   }
 
-Using the "@" object notation is strongly advised to make your configuration
+Using the ``@`` object notation is strongly advised to make your configuration
 file way more understandable:
 
 Please read the :ref:`Predefined_Rules` documentation to view examples on how
@@ -524,7 +524,7 @@ to provide parameters to rules through LKQL rule files.
     }
 
   Moreover, each instance must be identifiable through a unique name, thus the
-  following configuration is invalid and will lead to a GNATCheck error:
+  following configuration is invalid and will lead to a GNATcheck error:
 
   ::
 
@@ -535,6 +535,10 @@ to provide parameters to rules through LKQL rule files.
       ]
     }
 
+  However, if two instances have the same name **and** the same parameters,
+  GNATcheck will just ignore the duplicate instance and emit a warning instead
+  of an error so that the analysis can nevertheless be executed.
+
 Additionally to the ``rules`` top-level symbol, an LKQL rule file may export
 ``ada_rules`` and ``spark_rules`` symbols to enable associated rules,
 respectively, only on Ada code or only on SPARK code. Those symbols must also
@@ -624,8 +628,10 @@ defined in ``specific_rules.lkql``.
   are going to be searched in.
 
 You can enable the same rule in multiple files, but the constraint about the
-instance name uniqueness remains valid, meaning that such configuration is
-invalid:
+instance name uniqueness remains valid: when two instances have the same name,
+GNATcheck will emit an error if the instances have different parameters but
+ignore duplicate instances that are configured identically. That means such a
+configuration is invalid:
 
 .. code-block:: lkql
 
@@ -649,6 +655,21 @@ invalid:
   })
   # error: This rule configuration defines two instances with the same name: "Forbid_Attr"
 
+Note that GNATcheck will also detect instances that run the same check (i.e.,
+instances that have different names but are configured with the same
+parameters). In such cases, GNATcheck will emit a warning so that duplicate
+checks can be easily detected when combining rules object.
+
+Same restrictions apply when combining LKQL rules files with rules specified
+with the command line interface (using the ``--rule``
+:ref:`switch<General_gnatcheck_Switches>`), or through the ``Check``
+:ref:`GPR package<Check_GPR_Package>`.
+
+.. attention::
+
+   Combining :ref:`LKQL rule file<LKQL_options_file>` with the deprecated
+   :ref:`GNATcheck Rule Options<gnatcheck_Rule_Options>` is undefined behavior.
+
 
 .. _gnatcheck_Rule_Options:
 

lkql_checker/src/gnatcheck-compiler.adb

@@ -25,7 +25,8 @@ with Gnatcheck.Rules.Rule_Table;   use Gnatcheck.Rules.Rule_Table;
 with Gnatcheck.Source_Table;       use Gnatcheck.Source_Table;
 with Gnatcheck.String_Utilities;   use Gnatcheck.String_Utilities;
 
-with GNATCOLL.VFS; use GNATCOLL.VFS;
+with GNATCOLL.JSON; use GNATCOLL.JSON;
+with GNATCOLL.VFS;  use GNATCOLL.VFS;
 
 with Langkit_Support.Slocs; use Langkit_Support.Slocs;
 
@@ -339,6 +340,10 @@ package body Gnatcheck.Compiler is
       --  Analyze one line containing a builder output. Insert the relevant
       --  messages into gnatcheck diagnoses table.
 
+      procedure Process_Worker_Message
+        (Message : String; Printer : access procedure (S, L : String));
+      --  Helper to process messages received from the Worker
+
       ------------------
       -- Analyze_Line --
       ------------------
@@ -529,6 +534,24 @@ package body Gnatcheck.Compiler is
                else Get_Rule_Id (Message_Kind)));
       end Analyze_Line;
 
+      ----------------------------
+      -- Process_Worker_Message --
+      ----------------------------
+
+      procedure Process_Worker_Message
+        (Message : String; Printer : access procedure (S, L : String))
+      is
+         Decoded_Message : constant Read_Result := Read (Message);
+      begin
+         if Decoded_Message.Success then
+            Printer
+              (Decoded_Message.Value.Get ("message"),
+               Decoded_Message.Value.Get ("location"));
+         else
+            Printer (Message, "");
+         end if;
+      end Process_Worker_Message;
+
       --  Start of processing for Analyze_Output
 
    begin
@@ -600,12 +623,25 @@ package body Gnatcheck.Compiler is
                   end if;
                end;
             end if;
+         elsif Line_Len >= 16 and then Line (1 .. 13) = "WORKER_INFO: " then
+            Process_Worker_Message (Line (14 .. Line_Len), Info'Access);
          elsif Line_Len >= 16 and then Line (1 .. 16) = "WORKER_WARNING: " then
-            Warning (Line (17 .. Line_Len));
+            Process_Worker_Message (Line (17 .. Line_Len), Warning'Access);
          elsif Line_Len >= 14 and then Line (1 .. 14) = "WORKER_ERROR: " then
-            Error (Line (15 .. Line_Len));
+            Process_Worker_Message (Line (15 .. Line_Len), Error'Access);
             Detected_Internal_Error := @ + 1;
             Errors := True;
+         elsif Line_Len >= 23
+           and then Line (1 .. 23) = "WORKER_JSON_INSTANCES: "
+         then
+            --  Ignore the JSON instances data. This is analyzed in
+            --  Process_LKQL_Rule_File.
+
+            --  The current line can be longer than Line_Len, skip the rest of
+            --  the line if that's the case.
+            if Line_Len = Line'Length then
+               Skip_Line (File);
+            end if;
          else
             Analyze_Line (Line (1 .. Line_Len));
          end if;
@@ -1849,6 +1885,11 @@ package body Gnatcheck.Compiler is
       Num_Args := @ + 1;
       Args (Num_Args) := new String'(LKQL_RF_Name);
 
+      if Verbose_Mode then
+         Num_Args := @ + 1;
+         Args (Num_Args) := new String'("--verbose");
+      end if;
+
       --  Output the called command if in debug mode
       if Arg.Debug_Mode.Get then
          Put (Base_Name (Worker.all));

lkql_checker/src/gnatcheck-output.adb

@@ -228,12 +228,13 @@ package body Gnatcheck.Output is
    -- Info --
    ----------
 
-   procedure Info (Message : String) is
+   procedure Info (Message : String; Location : String := "") is
    begin
       Emit_Message
         (Message,
          Tag         => Info,
-         Tool_Name   => True,
+         Tool_Name   => Location = "",
+         Location    => Location,
          New_Line    => True,
          Log_Message => True);
    end Info;

lkql_checker/src/gnatcheck-output.ads

@@ -49,7 +49,7 @@ package Gnatcheck.Output is
    procedure Warning (Message : String; Location : String := "");
    --  Sends ``Message`` into stderr, prefixed by "tool_name: warning: ".
 
-   procedure Info (Message : String);
+   procedure Info (Message : String; Location : String := "");
    --  Sends ``Message`` into stderr, prefixed by "tool_name: info: ".
 
    procedure Info_In_Tty (Message : String);

lkql_checker/src/gnatcheck-rules-rule_table.adb

@@ -922,6 +922,7 @@ package body Gnatcheck.Rules.Rule_Table is
       Parser_Pid            : Process_Id;
       Waited_Pid            : Process_Id;
       Success               : Boolean;
+      Analyze_Error         : Boolean;
       Config_JSON           : Read_Result;
 
       procedure Rule_Object_Mapper
@@ -952,12 +953,35 @@ package body Gnatcheck.Rules.Rule_Table is
          Error ("can not call the LKQL rule file parser");
          Rule_Option_Problem_Detected := True;
       else
-         Config_JSON := Read (Read_File (JSON_Config_File_Name).all);
+         declare
+            Worker_Output_File : File_Type;
+         begin
+            Open (Worker_Output_File, In_File, JSON_Config_File_Name);
+
+            while not End_Of_File (Worker_Output_File) loop
+               declare
+                  Line : constant String := Get_Line (Worker_Output_File);
+               begin
+                  if Line (1 .. 23) = "WORKER_JSON_INSTANCES: " then
+                     Config_JSON := Read (Line (24 .. Line'Last));
+                     exit;
+                  end if;
+               end;
+            end loop;
+
+            Close (Worker_Output_File);
+         end;
+
+         --  Process diagnostics from worker's output
+         Analyze_Output (JSON_Config_File_Name, Analyze_Error);
 
          --  If the JSON parsing failed, it means that LKQL rule file
-         --  processing failed and diagnostics are in the output file.
-         if not Config_JSON.Success then
-            Analyze_Output (JSON_Config_File_Name, Success);
+         --  processing failed and diagnostics are in the output file and
+         --  they have been already processed.
+         if Analyze_Error
+           or else not Config_JSON.Success
+           or else Config_JSON.Value = JSON_Null
+         then
             Rule_Option_Problem_Detected := True;
 
          --  Else, populate the global rule table with the rule config

lkql_jit/cli/src/main/java/com/adacore/lkql_jit/cli/BaseLKQLChecker.java

@@ -173,7 +173,8 @@ protected Map<String, RuleInstance> getRuleInstances() {
                     ruleName,
                     Optional.empty(),
                     RuleInstance.SourceMode.GENERAL,
-                    instanceArgs.get(instanceId)
+                    instanceArgs.get(instanceId),
+                    null
                 )
             );
         }