Merge remote branch 'origin/master' into edge

Author: automatic-merge

source/ada/lsp-ada_handlers-other_file_commands.adb

@@ -111,31 +111,37 @@ package body LSP.Ada_Handlers.Other_File_Commands is
 
          function Other_File_From_Unit
            (Unit : GPR2.Build.Compilation_Unit.Object)
-           return GNATCOLL.VFS.Virtual_File;
+            return GNATCOLL.VFS.Virtual_File;
          --  Return the other file, knowing that the original file was
          --  related to Unit.
          --  Return No_File if no other file has been found
          --  (e.g: when querying the other file of a package that has only a
          --  a specification file).
 
-         function Unit_For_File return GPR2.Build.Compilation_Unit.Object;
-         --  Return the Unit object corresponding to File
+         function Unit_For_File
+           (Is_Multi_Unit : out Boolean)
+            return GPR2.Build.Compilation_Unit.Object;
+         --  Return the Unit object corresponding to File.
+         --  Set Is_Multi_Unit to True if File is a multi-unit file.
 
          --------------------------
          -- Other_File_From_Unit --
          --------------------------
 
          function Other_File_From_Unit
            (Unit : GPR2.Build.Compilation_Unit.Object)
-           return GNATCOLL.VFS.Virtual_File
+            return GNATCOLL.VFS.Virtual_File
          is
             Spec_File : Virtual_File;
             Body_File : Virtual_File;
          begin
-            Spec_File := (if Unit.Has_Part (S_Spec) then
-               Unit.Spec.Source.Virtual_File else No_File);
-            Body_File := (if Unit.Has_Part (S_Body) then
-               Unit.Main_Body.Source.Virtual_File else No_File);
+            Spec_File :=
+              (if Unit.Has_Part (S_Spec) then Unit.Spec.Source.Virtual_File
+               else No_File);
+            Body_File :=
+              (if Unit.Has_Part (S_Body)
+               then Unit.Main_Body.Source.Virtual_File
+               else No_File);
 
             if File = Spec_File then
                return Body_File;
@@ -149,7 +155,8 @@ package body LSP.Ada_Handlers.Other_File_Commands is
          -------------------
 
          function Unit_For_File
-           return GPR2.Build.Compilation_Unit.Object is
+           (Is_Multi_Unit : out Boolean)
+            return GPR2.Build.Compilation_Unit.Object is
          begin
             --  Check in the root project's closure for a visible source
             --  corresponding to this file.
@@ -163,17 +170,27 @@ package body LSP.Ada_Handlers.Other_File_Commands is
                   Unit           : GPR2.Build.Compilation_Unit.Object :=
                     GPR2.Build.Compilation_Unit.Undefined;
                begin
+                  Is_Multi_Unit := False;
+
                   --  The source is not visible from the root project (e.g:
                   --  when  querying the other file of an Ada file that
                   --  does not belong to the loaded project).
-                  if not Visible_Source.Is_Defined then
+                  if not Visible_Source.Is_Defined
+                    or else not Visible_Source.Has_Units
+                  then
                      return GPR2.Build.Compilation_Unit.Undefined;
                   end if;
 
                   declare
+                     Index     : constant GPR2.Unit_Index :=
+                       (if Visible_Source.Has_Unit_At (GPR2.No_Index)
+                        then GPR2.No_Index
+                        else GPR2.Multi_Unit_Index'First);
                      Unit_Info : constant GPR2.Build.Unit_Info.Object :=
-                       Visible_Source.Unit;
+                       Visible_Source.Unit (Index => Index);
                   begin
+                     Is_Multi_Unit := Index /= GPR2.No_Index;
+
                      if Unit_Info.Is_Defined then
                         Unit :=
                           View.Namespace_Roots.First_Element.Unit
@@ -188,8 +205,10 @@ package body LSP.Ada_Handlers.Other_File_Commands is
             end if;
          end Unit_For_File;
 
-         Unit       : constant GPR2.Build.Compilation_Unit.Object := Unit_For_File;
-         Other_File : Virtual_File;
+         Is_Multi_Unit : Boolean;
+         Unit          : constant GPR2.Build.Compilation_Unit.Object :=
+           Unit_For_File (Is_Multi_Unit => Is_Multi_Unit);
+         Other_File    : Virtual_File;
       begin
          Success := True;
 
@@ -229,23 +248,26 @@ package body LSP.Ada_Handlers.Other_File_Commands is
                        Use_Extended => True)
                   else ".adb");
             begin
-               if GNATCOLL.Utils.Ends_With
-                 (File.Display_Full_Name, Impl_Ext)
+               if GNATCOLL.Utils.Ends_With (File.Display_Full_Name, Impl_Ext)
                then
-                  return GNATCOLL.VFS.Create
-                    (Full_Filename => +GNATCOLL.Utils.Replace
-                       (S           => File.Display_Full_Name,
-                        Pattern     => Impl_Ext,
-                        Replacement => Spec_Ext));
+                  return
+                    GNATCOLL.VFS.Create
+                      (Full_Filename =>
+                         +GNATCOLL.Utils.Replace
+                            (S           => File.Display_Full_Name,
+                             Pattern     => Impl_Ext,
+                             Replacement => Spec_Ext));
                else
-                  return GNATCOLL.VFS.Create
-                    (Full_Filename => +GNATCOLL.Utils.Replace
-                       (S           => File.Display_Full_Name,
-                        Pattern     => Spec_Ext,
-                        Replacement => Impl_Ext));
+                  return
+                    GNATCOLL.VFS.Create
+                      (Full_Filename =>
+                         +GNATCOLL.Utils.Replace
+                            (S           => File.Display_Full_Name,
+                             Pattern     => Spec_Ext,
+                             Replacement => Impl_Ext));
                end if;
             end;
-         else
+         elsif not Is_Multi_Unit then
             Other_File := Other_File_From_Unit (Unit => Unit);
 
             if Other_File = No_File then
@@ -258,6 +280,16 @@ package body LSP.Ada_Handlers.Other_File_Commands is
             end if;
 
             return Other_File;
+         else
+            Success := False;
+            Error_Msg :=
+              VSS.Strings.Conversions.To_Virtual_String
+                ("Could not find other file for '"
+                 & File.Display_Base_Name
+                 & "': this is a multi-unit file, containing both "
+                 & "the package's specification and its body.");
+
+            return GNATCOLL.VFS.No_File;
          end if;
       end Get_Other_File;
 

source/ada/lsp-ada_handlers.ads

@@ -428,6 +428,7 @@ private
    overriding function Project_Tree_Is_Aggregate (Self : Message_Handler)
      return Boolean is
      (Self.Project_Tree_Is_Defined
+      and then Self.Project_Tree.Root_Project.Is_Defined
       and then Self.Project_Tree.Root_Project.Kind in GPR2.Aggregate_Kind);
 
    overriding procedure Reload_Project (Self : in out Message_Handler);

source/tester/tester-tests.adb

@@ -98,7 +98,7 @@ package body Tester.Tests is
    function Find_Matching_Request
      (Request      : GNATCOLL.JSON.JSON_Value;
       Search_Array : GNATCOLL.JSON.JSON_Array;
-      Request_ID   : out Integer)
+      Request_ID   : out Unbounded_String)
       return GNATCOLL.JSON.JSON_Value;
    --  Search for the matching Request in Search_Array. Return JSON_Null if
    --  Request was not matched.
@@ -930,9 +930,9 @@ package body Tester.Tests is
             for J in 1 .. GNATCOLL.JSON.Length (R) loop
                --  For each request, try to find the request with the same ID
                declare
-                  Expected    : constant GNATCOLL.JSON.JSON_Value :=
+                  Expected         : constant GNATCOLL.JSON.JSON_Value :=
                     GNATCOLL.JSON.Get (R, J);
-                  Expected_ID : Integer;
+                  Expected_ID      : Unbounded_String;
                   Matching_Request : constant GNATCOLL.JSON.JSON_Value :=
                     Find_Matching_Request
                       (Request      => Expected,
@@ -947,11 +947,11 @@ package body Tester.Tests is
                         Minimal => Minimal,
                         Result  => Result);
                   else
-                     if Expected_ID /= -1 then
+                     if Expected_ID = Null_Unbounded_String then
                         --  Alert the user we failed to find the request
                         Result.Append
                           ("Failed to find result for request:"
-                           & Expected_ID'Image);
+                           & Expected_ID);
                         Result.Append (Ada.Characters.Latin_1.LF);
                         Result.Append
                           ("Either the result was never received or the id "
@@ -982,26 +982,44 @@ package body Tester.Tests is
    function Find_Matching_Request
      (Request      : GNATCOLL.JSON.JSON_Value;
       Search_Array : GNATCOLL.JSON.JSON_Array;
-      Request_ID   : out Integer)
+      Request_ID   : out Unbounded_String)
       return GNATCOLL.JSON.JSON_Value
    is
-      function Get_ID (Value : GNATCOLL.JSON.JSON_Value) return Integer;
+      function Get_ID
+        (Value : GNATCOLL.JSON.JSON_Value) return Unbounded_String;
 
       ------------
       -- Get_ID --
       ------------
 
-      function Get_ID (Value : GNATCOLL.JSON.JSON_Value) return Integer is
+      function Get_ID
+        (Value : GNATCOLL.JSON.JSON_Value) return Unbounded_String is
       begin
          if Value.Kind = JSON_Object_Type and then Value.Has_Field ("id") then
-            return Value.Get ("id");
+            declare
+               ID : constant GNATCOLL.JSON.JSON_Value := Value.Get ("id");
+            begin
+               if ID.Kind = JSON_Int_Type then
+                  declare
+                     ID_Value : constant Integer := Value.Get ("id");
+                  begin
+                     return To_Unbounded_String (ID_Value'Image);
+                  end;
+               elsif ID.Kind = JSON_String_Type then
+                  declare
+                     ID_Value : constant String := Value.Get ("id");
+                  begin
+                     return To_Unbounded_String (ID_Value);
+                  end;
+               end if;
+            end;
          end if;
-         return -1;
+         return Null_Unbounded_String;
       end Get_ID;
 
    begin
       Request_ID := Get_ID (Request);
-      if Request_ID = -1 then
+      if Request_ID = Null_Unbounded_String then
          --  No ID, so left was not a request object
          return GNATCOLL.JSON.JSON_Null;
       end if;

testsuite/ada_lsp/commands.other_file.multi_unit_file/multi.gpr

@@ -0,0 +1,13 @@
+project Multi is
+   for Object_Dir use "obj";
+   for Source_Dirs use ("src");
+   for Exec_Dir use ".";
+   for Main use ("main.adb");
+
+   package Naming is
+      for Specification ("U") use "u.adb" at 1;
+      for Body ("U") use "u.adb" at 2;
+      for Body ("U.V") use "sep.adb" at 1;
+      for Body ("U.W") use "sep.adb" at 2;
+   end Naming;
+end Multi;

testsuite/ada_lsp/commands.other_file.multi_unit_file/src/main.adb

@@ -0,0 +1,9 @@
+with U;
+with Ada;
+with Pkg;
+
+procedure Main is
+begin
+   U.V;
+   Pkg.Foo;
+end Main;

testsuite/ada_lsp/commands.other_file.multi_unit_file/src/pkg.adb

@@ -0,0 +1,3 @@
+package body Pkg is
+   procedure Foo is null;
+end Pkg;

testsuite/ada_lsp/commands.other_file.multi_unit_file/src/pkg.ads

@@ -0,0 +1,3 @@
+package Pkg is
+   procedure Foo;
+end Pkg;

testsuite/ada_lsp/commands.other_file.multi_unit_file/src/sep.adb

@@ -0,0 +1,11 @@
+with Ada.Text_IO;
+separate (U) procedure V is
+begin
+   Ada.Text_IO.Put_Line ("U.V.");
+end V;
+
+with GNAT.Regexp;
+separate (U) procedure W is
+begin
+   null;
+end W;

testsuite/ada_lsp/commands.other_file.multi_unit_file/src/u.adb

@@ -0,0 +1,11 @@
+package U is
+   procedure V;
+end U;
+
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+package body U is
+   procedure V is separate;
+   procedure W is separate;
+begin
+   W;
+end U;