Merge remote branch 'origin/master' into edge

Author: automatic-merge

source/ada/lsp-ada_contexts.adb

@@ -909,8 +909,26 @@ package body LSP.Ada_Contexts is
       Attribute    : GPR2.Q_Attribute_Id;
       Index        : String := "";
       Default      : String := "";
-      Use_Extended : Boolean := False) return String
-   is
+      Use_Extended : Boolean := False) return String is
+   begin
+      return Project_Attribute_Value
+        (View         => Self.Tree.Root_Project,
+         Attribute    => Attribute,
+         Index        => Index,
+         Default      => Default,
+         Use_Extended => Use_Extended);
+   end Project_Attribute_Value;
+
+   -----------------------------
+   -- Project_Attribute_Value --
+   -----------------------------
+
+   function Project_Attribute_Value
+     (View         : GPR2.Project.View.Object;
+      Attribute    : GPR2.Q_Attribute_Id;
+      Index        : String := "";
+      Default      : String := "";
+      Use_Extended : Boolean := False) return String is
       Attribute_Index : constant GPR2.Project.Attribute_Index.Object :=
         (if Index = ""
          then GPR2.Project.Attribute_Index.Undefined
@@ -919,19 +937,19 @@ package body LSP.Ada_Contexts is
       Attribute_Value : GPR2.Project.Attribute.Object;
 
    begin
-      if Self.Tree.Root_Project.Check_Attribute
+      if View.Check_Attribute
         (Name   => Attribute,
          Index  => Attribute_Index,
          Result => Attribute_Value)
       then
          return Attribute_Value.Value.Text;
-      elsif Use_Extended and then Self.Tree.Root_Project.Is_Extending then
-            --  Look at Extended project list as attribute not found in
-            --  Root_Project and Use_Extended requested.
+      elsif Use_Extended and then View.Is_Extending then
+         --  Look at Extended project list as attribute not found in
+         --  Root_Project and Use_Extended requested.
 
          declare
             Extended_Root : GPR2.Project.View.Object :=
-              Self.Tree.Root_Project.Extended_Root;
+              View.Extended_Root;
          begin
             while Extended_Root.Is_Defined loop
                if Extended_Root.Check_Attribute

source/ada/lsp-ada_contexts.ads

@@ -285,6 +285,15 @@ package LSP.Ada_Contexts is
    --  itself, then the attribute is looked up in the project extended by
    --  Project (if any).
 
+   function Project_Attribute_Value
+     (View         : GPR2.Project.View.Object;
+      Attribute    : GPR2.Q_Attribute_Id;
+      Index        : String := "";
+      Default      : String := "";
+      Use_Extended : Boolean := False) return String;
+   --  Same as above, but computing the value from the given view instead
+   --  of the context's root project.
+
 private
 
    type Context (Tracer : not null LSP.Tracers.Tracer_Access) is tagged limited

source/ada/lsp-ada_handlers-other_file_commands.adb

@@ -15,16 +15,20 @@
 -- of the license.                                                          --
 ------------------------------------------------------------------------------
 
+with GNATCOLL.Utils;
+with GPR2;                 use GPR2;
+with GPR2.Build.Source;
 with GPR2.Build.Unit_Info;
 with GPR2.Project.View;
 with VSS.JSON.Streams;
 
-with GNATCOLL.VFS; use GNATCOLL.VFS;
+with GNATCOLL.VFS;         use GNATCOLL.VFS;
 
 with GPR2.Build.Compilation_Unit;
 with GPR2.Path_Name;
 
 with LSP.Constants;
+with LSP.Enumerations;
 with LSP.Servers;
 
 package body LSP.Ada_Handlers.Other_File_Commands is
@@ -85,13 +89,23 @@ package body LSP.Ada_Handlers.Other_File_Commands is
       File : constant GNATCOLL.VFS.Virtual_File :=
         Handler.To_File (Self.URI);
 
-      function Other_File return GNATCOLL.VFS.Virtual_File;
+      function Get_Other_File
+        (Success   : out Boolean;
+         Error_Msg : out VSS.Strings.Virtual_String)
+         return GNATCOLL.VFS.Virtual_File;
+      --  Return File's other file. If it does not exist,
+      --  Success is set to False and it will return No_File,
+      --  with an Error_Msg explaining why the other file could not be found.
 
-      ----------------
-      -- Other_File --
-      ----------------
+      --------------------
+      -- Get_Other_File --
+      --------------------
 
-      function Other_File return GNATCOLL.VFS.Virtual_File is
+      function Get_Other_File
+        (Success   : out Boolean;
+         Error_Msg : out VSS.Strings.Virtual_String)
+         return GNATCOLL.VFS.Virtual_File
+      is
 
          F : constant GPR2.Path_Name.Object := GPR2.Path_Name.Create (File);
 
@@ -100,9 +114,12 @@ package body LSP.Ada_Handlers.Other_File_Commands is
            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;
-         --   File the Unit object corresponding to File.
+         --  Return the Unit object corresponding to File
 
          --------------------------
          -- Other_File_From_Unit --
@@ -115,8 +132,11 @@ package body LSP.Ada_Handlers.Other_File_Commands is
             Spec_File : Virtual_File;
             Body_File : Virtual_File;
          begin
-            Spec_File := Unit.Spec.Source.Virtual_File;
-            Body_File := Unit.Main_Body.Source.Virtual_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;
             else
@@ -128,48 +148,141 @@ package body LSP.Ada_Handlers.Other_File_Commands is
          -- Unit_For_File --
          -------------------
 
-         function Unit_For_File return GPR2.Build.Compilation_Unit.Object is
+         function Unit_For_File
+           return GPR2.Build.Compilation_Unit.Object is
          begin
             --  Check in the root project's closure for a visible source
             --  corresponding to this file.
             --  Not that the root's project closure includes the runtime.
             if Handler.Project_Tree.Is_Defined then
                declare
-                  View      : constant GPR2.Project.View.Object :=
+                  View           : constant GPR2.Project.View.Object :=
                     Handler.Project_Tree.Root_Project;
-                  Unit_Info : constant GPR2.Build.Unit_Info.Object :=
-                    View.Visible_Source (F.Simple_Name).Unit;
-                  Unit      : GPR2.Build.Compilation_Unit.Object :=
+                  Visible_Source : constant GPR2.Build.Source.Object :=
+                    View.Visible_Source (F.Simple_Name);
+                  Unit           : GPR2.Build.Compilation_Unit.Object :=
                     GPR2.Build.Compilation_Unit.Undefined;
                begin
-                  if Unit_Info.Is_Defined then
-                     Unit := View.Namespace_Roots.First_Element.Unit
-                       (Unit_Info.Name);
+                  --  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
+                     return GPR2.Build.Compilation_Unit.Undefined;
                   end if;
 
-                  return Unit;
+                  declare
+                     Unit_Info : constant GPR2.Build.Unit_Info.Object :=
+                       Visible_Source.Unit;
+                  begin
+                     if Unit_Info.Is_Defined then
+                        Unit :=
+                          View.Namespace_Roots.First_Element.Unit
+                            (Unit_Info.Name);
+                     end if;
+
+                     return Unit;
+                  end;
                end;
             else
                return GPR2.Build.Compilation_Unit.Undefined;
             end if;
          end Unit_For_File;
 
+         Unit       : constant GPR2.Build.Compilation_Unit.Object := Unit_For_File;
+         Other_File : Virtual_File;
       begin
-         return Other_File_From_Unit (Unit_For_File);
-      end Other_File;
-
-      URI : constant LSP.Structures.DocumentUri :=
-        Handler.To_URI (Other_File.Display_Full_Name);
+         Success := True;
+
+         --  The unit is defined for the loaded project: fallback to a simple
+         --  heuristic which tries to deduce the other file from the queried
+         --  file, switching the specification/implementation extensions at
+         --  the end of the filename.
+         --  If the computed other file's URI does not exist, the client will
+         --  simply not open it, which is ok.
+
+         if not Unit.Is_Defined then
+            declare
+               Impl_Suffix_Attr_Id   : constant GPR2.Q_Optional_Attribute_Id :=
+                 ((Pack => GPR2."+" ("Naming"),
+                   Attr => GPR2."+" ("Implementation_Suffix")));
+               Spec_Suffix_Attr_Id   : constant GPR2.Q_Optional_Attribute_Id :=
+                 ((Pack => GPR2."+" ("Naming"),
+                   Attr => GPR2."+" ("Specification_Suffix")));
+               Spec_Ext              : constant String :=
+                 LSP.Ada_Contexts.Project_Attribute_Value
+                   (View         => Handler.Project_Tree.Root_Project,
+                    Attribute    => Spec_Suffix_Attr_Id,
+                    Index        => "ada",
+                    Default      => ".ads",
+                    Use_Extended => True);
+               Impl_Ext              : constant String :=
+                 LSP.Ada_Contexts.Project_Attribute_Value
+                   (View         => Handler.Project_Tree.Root_Project,
+                    Attribute    => Impl_Suffix_Attr_Id,
+                    Index        => "ada",
+                    Default      => ".adb",
+                    Use_Extended => True);
+            begin
+               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));
+               else
+                  return GNATCOLL.VFS.Create
+                    (Full_Filename => +GNATCOLL.Utils.Replace
+                       (S           => File.Display_Full_Name,
+                        Pattern     => Spec_Ext,
+                        Replacement => Impl_Ext));
+               end if;
+            end;
+         else
+            Other_File := Other_File_From_Unit (Unit => Unit);
+
+            if Other_File = No_File then
+               Success := False;
+               Error_Msg :=
+                 VSS.Strings.Conversions.To_Virtual_String
+                   ("Could not find other file for '"
+                    & File.Display_Base_Name
+                    & "': the unit has no other part.");
+            end if;
 
-      Message : constant LSP.Structures.ShowDocumentParams :=
-        (uri       => (VSS.Strings.Virtual_String (URI) with null record),
-         takeFocus => LSP.Constants.True,
-         others    => <>);
+            return Other_File;
+         end if;
+      end Get_Other_File;
 
-      New_Id : constant LSP.Structures.Integer_Or_Virtual_String :=
-        Handler.Server.Allocate_Request_Id;
+      Success    : Boolean;
+      Error_Msg  : VSS.Strings.Virtual_String;
+      Other_File : constant Virtual_File :=
+        Get_Other_File (Success, Error_Msg);
    begin
-      Handler.Sender.On_ShowDocument_Request (New_Id, Message);
+      if not Success then
+         Error :=
+           (Is_Set => True,
+            Value  =>
+              (code    => LSP.Enumerations.InternalError,
+               message => Error_Msg));
+         return;
+      end if;
+
+      declare
+         URI : constant LSP.Structures.DocumentUri :=
+           Handler.To_URI (Other_File.Display_Full_Name);
+
+         Message : constant LSP.Structures.ShowDocumentParams :=
+           (uri       => (VSS.Strings.Virtual_String (URI) with null record),
+            takeFocus => LSP.Constants.True,
+            others    => <>);
+
+         New_Id : constant LSP.Structures.Integer_Or_Virtual_String :=
+           Handler.Server.Allocate_Request_Id;
+      begin
+         Handler.Sender.On_ShowDocument_Request (New_Id, Message);
+      end;
    end Execute;
 
    ----------------

source/ada/lsp-ada_project_loading.adb

@@ -86,7 +86,7 @@ package body LSP.Ada_Project_Loading is
               ("The project file has errors and could not be loaded.");
          when Valid_Project_With_Warning =>
             return VSS.Strings.To_Virtual_String
-              ("The project file was loaded but contains Warnings.");
+              ("The project file was loaded but contains warnings.");
       end case;
    end Load_Status_Message;
 
@@ -159,17 +159,7 @@ package body LSP.Ada_Project_Loading is
          Parent_Diagnostic.source := "ada.project";
          Parent_Diagnostic.severity :=
            (True, Load_Status_Severity (Project));
-
-         Parent_Diagnostic.message := "Project Problems";
-         Parent_Diagnostic.relatedInformation.Append
-           (LSP.Structures.DiagnosticRelatedInformation'
-              (location =>
-                   LSP.Structures.Location'
-                 (uri     => Project_URI,
-                  a_range => Backup_Sloc,
-                  others  => <>),
-               message  =>
-                 Load_Status_Message (Project)));
+         Parent_Diagnostic.message := Load_Status_Message (Project);
       end Create_Project_Loading_Diagnostic;
 
       -----------------------------
@@ -178,7 +168,6 @@ package body LSP.Ada_Project_Loading is
 
       procedure Append_GPR2_Diagnostics is
          use GPR2.Message;
-         use LSP.Enumerations;
       begin
          for Msg of GPR2_Messages loop
             if Msg.Level in GPR2.Message.Warning .. GPR2.Message.Error then
@@ -206,19 +195,6 @@ package body LSP.Ada_Project_Loading is
                                (Msg.Message)));
                   end if;
                end;
-
-               --  If we have one error in the GPR2 messages, the parent
-               --  diagnostic's severity should be "error" too, otherwise
-               --  "warning".
-               if Msg.Level = GPR2.Message.Error then
-                  Parent_Diagnostic.severity :=
-                    (True, LSP.Enumerations.Error);
-               elsif Parent_Diagnostic.severity.Value /=
-                 LSP.Enumerations.Error
-               then
-                  Parent_Diagnostic.severity :=
-                    (True, LSP.Enumerations.Warning);
-               end if;
             end if;
          end loop;
       end Append_GPR2_Diagnostics;

testsuite/ada_lsp/commands.other_file.error_messages/default.gpr

@@ -0,0 +1,3 @@
+project Default is
+   for Source_Dirs use ("src");
+end Default;

testsuite/ada_lsp/commands.other_file.error_messages/src/a.ads

@@ -0,0 +1,2 @@
+package A with Pure is
+end A;

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

@@ -0,0 +1,4 @@
+procedure Main is
+begin
+   null;
+end Main;