Merge remote branch 'origin/master' into edge

(no-precommit-check no-tn-check)

Author: mergerepo

source/tester/tester-tests.adb

@@ -151,6 +151,40 @@ package body Tester.Tests is
    is
       use type Ada.Calendar.Time;
 
+      procedure Check_Unique_Id (Request_Id : GNATCOLL.JSON.JSON_Value);
+      --  Check if Request_Id is unique over all request ids
+
+      ---------------------
+      -- Check_Unique_Id --
+      ---------------------
+
+      procedure Check_Unique_Id (Request_Id : GNATCOLL.JSON.JSON_Value) is
+         Id : VSS.Strings.Virtual_String;
+      begin
+         case Request_Id.Kind is
+            when GNATCOLL.JSON.JSON_String_Type =>
+               Id := VSS.Strings.Conversions.To_Virtual_String
+                 (String'(Request_Id.Get));
+            when GNATCOLL.JSON.JSON_Int_Type =>
+               Id := VSS.Strings.Conversions.To_Virtual_String
+                 (Integer'Image (Request_Id.Get));
+            when others =>
+               raise Program_Error with "Unexpected 'id' type!";
+         end case;
+
+         if Self.Known_Ids.Contains (Id) then
+            declare
+               Text : Spawn.String_Vectors.UTF_8_String_Vector;
+            begin
+               Text.Append ("Duplicated request id:");
+               Text.Append (VSS.Strings.Conversions.To_UTF_8_String (Id));
+               Self.Do_Fail (Text);
+            end;
+         else
+            Self.Known_Ids.Insert (Id);
+         end if;
+      end Check_Unique_Id;
+
       Request : constant GNATCOLL.JSON.JSON_Value := Command.Get ("request");
       Wait    : constant GNATCOLL.JSON.JSON_Array := Get (Command, "wait");
       Sort    : constant GNATCOLL.JSON.JSON_Value := Command.Get ("sortReply");
@@ -160,6 +194,10 @@ package body Tester.Tests is
 
       Timeout : constant Duration := Max_Wait * Wait_Factor (Command);
    begin
+      if Request.Has_Field ("id") and Request.Has_Field ("method") then
+         Check_Unique_Id (Request.Get ("id"));
+      end if;
+
       Self.Started := Ada.Calendar.Clock;
       Self.Waits := Wait;
       Self.Sort_Reply := Sort;

source/tester/tester-tests.ads

@@ -16,9 +16,11 @@
 ------------------------------------------------------------------------------
 
 with Ada.Calendar;
+with Ada.Containers.Hashed_Sets;
 with Ada.Strings.Unbounded;
 
 private with VSS.Strings;
+private with VSS.Strings.Hash;
 
 with GNATCOLL.JSON;
 
@@ -47,6 +49,12 @@ private
       entry Cancel;
    end Watch_Dog_Task;
 
+   package String_Sets is new Ada.Containers.Hashed_Sets
+     (VSS.Strings.Virtual_String,
+      VSS.Strings.Hash,
+      VSS.Strings."=",
+      VSS.Strings."=");
+
    type Test is new LSP.Raw_Clients.Raw_Client with record
       Index        : Positive := 1;
       Sort_Reply   : GNATCOLL.JSON.JSON_Value;
@@ -58,9 +66,12 @@ private
       --  Task to restrict a command execution time
       Started      : Ada.Calendar.Time;
       --  Command execution start/reset time
+      Known_Ids    : String_Sets.Set;
+      --  Set of processed request ids
 
       Full_Server_Output : GNATCOLL.JSON.JSON_Array;
       --  Complete output received from the server
+
    end record;
 
    overriding procedure On_Error

testsuite/ada_lsp/SC28-001.named.parameters.0/SC28-001.named.parameters.0.json

@@ -192,7 +192,7 @@
         "send": {
             "request": {
                 "jsonrpc": "2.0",
-                "id": "ada-1",
+                "id": "ada-2",
                 "method": "textDocument/codeAction",
                 "params": {
                     "textDocument": {
@@ -216,7 +216,7 @@
             "wait": [
                 {
                     "jsonrpc": "2.0",
-                    "id": "ada-1",
+                    "id": "ada-2",
                     "result": [
                         {
                             "title": "Name parameters in the call",

testsuite/ada_lsp/completion.aggregates.derived_private/test.json

@@ -225,7 +225,7 @@
       "send": {
          "request": {
             "jsonrpc": "2.0",
-            "id": 6,
+            "id": 7,
             "method": "shutdown"
          },
          "wait": []