Merge remote branch 'origin/master' into edge

AdaCore · Jul 19, 2024 · 901f228 · 901f228
2 parents c8f71bc + 52a5dc1
commit 901f228
Show file tree

Hide file tree

Showing 15 changed files with 327 additions and 50 deletions.
diff --git a/.vscode/extensions.json b/.vscode/extensions.json
@@ -9,6 +9,8 @@
       "gruntfuggly.triggertaskonsave",
       "davidanson.vscode-markdownlint",
       "adacore.ada",
-      "ms-vscode.extension-test-runner"
+      "ms-vscode.extension-test-runner",
+      "timonwong.shellcheck",
+      "foxundermoon.shell-format"
    ]
 }
diff --git a/.vscode/settings.json.tmpl b/.vscode/settings.json.tmpl
@@ -26,6 +26,10 @@
    "[yaml]": {
       "editor.defaultFormatter": "esbenp.prettier-vscode"
    },
+   "[shellscript]": {
+      "editor.formatOnSave": true,
+      "editor.defaultFormatter": "foxundermoon.shell-format"
+   },
    "terminal.integrated.env.osx": {
       // Dependencies can be provided under the subprojects/ directory. They
       // would automatically be included in GPR_PROJECT_PATH by the following

diff --git a/integration/vscode/ada/test/suite/general/debug.test.ts b/integration/vscode/ada/test/suite/general/debug.test.ts
@@ -9,7 +9,7 @@ import { exe } from '../../../src/helpers';
 import { activate } from '../utils';
 import { adaExtState } from '../../../src/extension';
 
-suite('Debug Configurations', function () {
+suite('Dbg Cfgs', function () {
     let expectedConfigs: AdaConfig[];
 
     this.beforeAll(async () => {
@@ -88,7 +88,7 @@ suite('Debug Configurations', function () {
         ];
     });
 
-    test('GDB path is explicitely set in offered debug config', async () => {
+    test('GDB path is set in offered config', async () => {
         const firstConfig = (await adaDynamicDebugConfigProvider.provideDebugConfigurations()).at(
             0
         ) as AdaConfig;

diff --git a/source/ada/lsp-ada_document_symbol.adb b/source/ada/lsp-ada_document_symbol.adb
@@ -337,11 +337,23 @@ package body LSP.Ada_Document_Symbol is
 
             when Libadalang.Common.Ada_Pragma_Node =>
                if Self.Stack.Length < 3 then
-                  Append_Name
-                    (Node.As_Pragma_Node.F_Id,
-                     Kind   => LSP.Enumerations.Property,
-                     Detail => VSS.Strings.To_Virtual_String
-                       ("(" & Node.As_Pragma_Node.F_Args.Text & ")"));
+                  declare
+                     Pragma_Node : constant Libadalang.Analysis.Pragma_Node :=
+                       Node.As_Pragma_Node;
+                  begin
+                     if not
+                       (Pragma_Node.F_Id.Is_Null
+                        and then Pragma_Node.F_Args.Is_Null)
+                     then
+                        Append_Name
+                          (Node.As_Pragma_Node.F_Id,
+                           Kind   => LSP.Enumerations.Property,
+                           Detail =>
+                             VSS.Strings.To_Virtual_String
+                               ("("
+                                & Node.As_Pragma_Node.F_Args.Text & ")"));
+                     end if;
+                  end;
                end if;
 
             when others =>

diff --git a/source/ada/lsp-ada_documents.adb b/source/ada/lsp-ada_documents.adb
@@ -132,10 +132,113 @@ package body LSP.Ada_Documents is
       --  Return a suitable sortText according to the completion item's
       --  visibility and position in the completion list.
 
+      procedure Get_Missing_Unit_And_Qualifier
+        (Missing_Unit_Name : out VSS.Strings.Virtual_String;
+         Missing_Qualifier : out VSS.Strings.Virtual_String);
+      --  Get the missing unit name and qualifier (if needed) for invisible
+      --  completion items.
+
       procedure Append_Auto_Import_Command;
       --  Append the needed command to add the missing with-clause/qualifier
       --  when accepting an invisible completion item.
 
+      ------------------------------------
+      -- Get_Missing_unit_and_qualifier --
+      ------------------------------------
+
+      procedure Get_Missing_Unit_And_Qualifier
+        (Missing_Unit_Name : out VSS.Strings.Virtual_String;
+         Missing_Qualifier : out VSS.Strings.Virtual_String)
+      is
+         use Libadalang.Analysis;
+
+         Prefix : constant VSS.Strings.Virtual_String :=
+           VSS.Strings.Conversions.To_Virtual_String
+             (Langkit_Support.Text.To_UTF8 (Node.Text));
+
+         Dotted_Node         : constant Ada_Node :=
+           (if Node.Kind in Libadalang.Common.Ada_Dotted_Name_Range then
+               Node
+            else
+               Node.Parent);
+
+         Is_Dotted_Name     : constant Boolean :=
+           not Dotted_Node.Is_Null and then
+           Dotted_Node.Kind in Libadalang.Common.Ada_Dotted_Name_Range;
+         --  Check if we are completing a dotted name. We want to prepend the
+         --  right qualifier only if it's not the case.
+
+         Dotted_Node_Prefix  : VSS.Strings.Virtual_String :=
+           (if Is_Dotted_Name then
+               VSS.Strings.Conversions.To_Virtual_String
+                 (Langkit_Support.Text.To_UTF8
+                   (Dotted_Node.As_Dotted_Name.F_Prefix.Text))
+            else
+               VSS.Strings.Empty_Virtual_String);
+         --  The prefix of the dotted name we are completion, or an empty
+         --  string if we are not completing a dotted name.
+
+         Missing_Unit_Root_Decl : constant Libadalang.Analysis.Basic_Decl :=
+           BD.P_Enclosing_Compilation_Unit.P_Decl;
+         --  The missing unit root declaration for this invisible symbol (e.g:
+         --  the "Ada.Text_IO" package declaration for the
+         --  "Ada.Text_IO.Put_Line" subprogram).
+
+      begin
+         Missing_Unit_Name :=  VSS.Strings.Conversions.To_Virtual_String
+           (Langkit_Support.Text.To_UTF8
+              (Missing_Unit_Root_Decl.P_Fully_Qualified_Name));
+
+         --  We are completing a dotted name but its prefix does not match
+         --  with the completion item's defining name's unit: this means we
+         --  are dealing with renames (e.g: 'GNAT.Strings.Strings_Access'
+         --  is a forward declaration of 'System.Strings.String_Access'). In
+         --  that case, use the prefix specified by the user instead of the
+         --  completion item's defining name's unit: the user explcitly wants
+         --  to use the renamed symbol instead of the base one.
+
+         if Is_Dotted_Name
+           and then not Missing_Unit_Name.Starts_With (Dotted_Node_Prefix)
+         then
+            declare
+               Dotted_Prefix_Parts : VSS.String_Vectors.
+                 Virtual_String_Vector :=
+                 Dotted_Node_Prefix.Split
+                   (Separator => VSS.Characters.Latin.Full_Stop);
+            begin
+               --  Check if the unit specified as a prefix actually exists.
+               --  If not, it might be a renamed package
+               --  declaration/instantiation: in that case we want to add a
+               --  with-clause on the enclosing unit (e.g: the prefix before
+               --  the last '.').
+
+               while Get_From_Provider
+                 (Context => Context.LAL_Context,
+                  Name    => Langkit_Support.Text.To_Text
+                    (VSS.Strings.Conversions.To_UTF_8_String
+                         (Dotted_Node_Prefix)),
+                  Kind    => Libadalang.Common.Unit_Specification).Root.Is_Null
+               loop
+                  Dotted_Prefix_Parts.Delete_Last;
+                  Dotted_Node_Prefix :=
+                    Dotted_Prefix_Parts.Join (VSS.Characters.Latin.Full_Stop);
+               end loop;
+
+               Missing_Unit_Name := Dotted_Node_Prefix;
+            end;
+         end if;
+
+         --  We should not add any qualifier if the user accepted the
+         --  completion item corresponding to the missing unit itself (e.g: if
+         --  the user selects "Ada.Text_IO" in the completion window, we do not
+         --  need to add any qualifier) or if he's completing a dotted name.
+         Missing_Qualifier :=
+           (if Is_Dotted_Name or else BD = Missing_Unit_Root_Decl then
+               VSS.Strings.Empty_Virtual_String
+            else
+               Missing_Unit_Name);
+      end Get_Missing_Unit_And_Qualifier;
+
       -------------------
       -- Get_Sort_Text --
       -------------------
@@ -166,43 +269,15 @@ package body LSP.Ada_Documents is
 
       procedure Append_Auto_Import_Command is
          use LSP.Ada_Handlers.Refactor;
-         use Libadalang.Analysis;
 
          Auto_Import_Command : Auto_Import.Command;
          --  The auto-import command.
 
-         Is_Dotted_Name     : constant Boolean :=
-           Node.Kind in Libadalang.Common.Ada_Dotted_Name_Range
-           or else
-             (not Node.Parent.Is_Null and then
-              Node.Parent.Kind
-              in Libadalang.Common.Ada_Dotted_Name_Range);
-         --  Check if we are completing a dotted name. We want to prepend the
-         --  right qualifier only if it's not the case.
-
-         Missing_Unit_Root_Decl : constant Libadalang.Analysis.Basic_Decl :=
-           BD.P_Enclosing_Compilation_Unit.P_Decl;
-         --  The missing unit root declaration for this invisible symbol (e.g:
-         --  the "Ada.Text_IO" package declaration for the
-         --  "Ada.Text_IO.Put_Line" subprogram).
-
-         Missing_Unit_Name  : VSS.Strings.Virtual_String :=
-           VSS.Strings.Conversions.To_Virtual_String
-             (Langkit_Support.Text.To_UTF8
-                (Missing_Unit_Root_Decl.P_Fully_Qualified_Name));
-         --  Get the missing unit name.
-
-         Missing_Qualifier  : VSS.Strings.Virtual_String :=
-           (if Is_Dotted_Name or else BD = Missing_Unit_Root_Decl then
-               VSS.Strings.Empty_Virtual_String
-            else
-               Missing_Unit_Name);
-         --  The missing qualifier. We should not add any qualifier if the
-         --  user accepted the completion item corresponding to the missing
-         --  unit itself (e.g: if the user selects "Ada.Text_IO" in the
-         --  completion window, we do not need to add any qualifier) or if
-         --  he's completing a dotted name.
+         Missing_Unit_Name  : VSS.Strings.Virtual_String;
+         Missing_Qualifier  : VSS.Strings.Virtual_String;
       begin
+         Get_Missing_Unit_And_Qualifier (Missing_Unit_Name, Missing_Qualifier);
+
          Auto_Import_Command.Initialize
            (Context     => Context,
             Where       =>

diff --git a/source/ada/lsp-ada_handlers.adb b/source/ada/lsp-ada_handlers.adb
@@ -3245,9 +3245,7 @@ package body LSP.Ada_Handlers is
          declare
             Message : constant VSS.Strings.Virtual_String :=
               VSS.Strings.Conversions.To_Virtual_String
-                ("Exception: " &
-                   Ada.Exceptions.Exception_Name (E) & " (" &
-                     Ada.Exceptions.Exception_Message (E) & ")");
+                ("Exception: " & Ada.Exceptions.Exception_Information (E));
 
          begin
             Self.Tracer.Trace_Exception (E, "On_Server_Request");

diff --git a/source/ada/lsp-gnatcoll_tracers.adb b/source/ada/lsp-gnatcoll_tracers.adb
@@ -90,8 +90,7 @@ package body LSP.GNATCOLL_Tracers is
         (if Message.Is_Empty then "Exception:" else Message);
 
       Self.Trace
-        (Ada.Exceptions.Exception_Name (Error) & " - " &
-           Ada.Exceptions.Exception_Message (Error));
+        (Ada.Exceptions.Exception_Information (Error));
 
       Self.Trace (GNAT.Traceback.Symbolic.Symbolic_Traceback (Error));
    end Trace_Exception;

diff --git a/source/gpr/lsp-gpr_documents.adb b/source/gpr/lsp-gpr_documents.adb
@@ -240,8 +240,7 @@ package body LSP.GPR_Documents is
            (GPR2.Message.Create
               (Level   => GPR2.Message.Error,
                Message => "GPR parser unexpected " &
-                 Ada.Exceptions.Exception_Name (E) & " " &
-                 Ada.Exceptions.Exception_Message (E),
+                 Ada.Exceptions.Exception_Information (E),
                Sloc    => GPR2.Source_Reference.Create
                  (Filename => Self.File.Value,
                   Line     => 1,

diff --git a/source/server/lsp-server_request_jobs.adb b/source/server/lsp-server_request_jobs.adb
@@ -51,9 +51,7 @@ package body LSP.Server_Request_Jobs is
          declare
             Message : constant VSS.Strings.Virtual_String :=
               VSS.Strings.Conversions.To_Virtual_String
-                ("Exception: " &
-                   Ada.Exceptions.Exception_Name (E) & " (" &
-                     Ada.Exceptions.Exception_Message (E) & ")");
+                ("Exception: " & Ada.Exceptions.Exception_Information (E));
 
          begin
             Client.On_Error_Response

diff --git a/testsuite/ada_lsp/completion.invisible.insert_with_clause.renamed_units/bar.ads b/testsuite/ada_lsp/completion.invisible.insert_with_clause.renamed_units/bar.ads
@@ -0,0 +1,5 @@
+package Bar is
+
+   procedure Do_Something is null;
+
+end Bar;
diff --git a/testsuite/ada_lsp/completion.invisible.insert_with_clause.renamed_units/default.gpr b/testsuite/ada_lsp/completion.invisible.insert_with_clause.renamed_units/default.gpr
@@ -0,0 +1,2 @@
+project Default is
+end Default;
diff --git a/testsuite/ada_lsp/completion.invisible.insert_with_clause.renamed_units/foo.ads b/testsuite/ada_lsp/completion.invisible.insert_with_clause.renamed_units/foo.ads
@@ -0,0 +1,3 @@
+with Bar;
+
+package Foo renames Bar;
diff --git a/testsuite/ada_lsp/completion.invisible.insert_with_clause.renamed_units/main.adb b/testsuite/ada_lsp/completion.invisible.insert_with_clause.renamed_units/main.adb
@@ -0,0 +1,4 @@
+procedure Main is
+begin
+   Foo.Do_Some
+end Main;