Merge remote branch 'origin/master' into edge

integration/vscode/ada/src/extension.ts

@@ -31,6 +31,7 @@ import {
     getEvaluatedCustomEnv,
     setCustomEnvironment,
 } from './helpers';
+import { ExecuteCommandRequest } from 'vscode-languageclient/node';
 
 const ADA_CONTEXT = 'ADA_PROJECT_CONTEXT';
 export let contextClients: ContextClients;
@@ -111,66 +112,76 @@ type ALSSourceDirDescription = {
  *
  */
 async function checkSrcDirectories(alsClient: LanguageClient) {
-    if (vscode.workspace.workspaceFile !== undefined) {
-        await alsClient
-            .sendRequest<[ALSSourceDirDescription]>('workspace/alsSourceDirs')
-            .then(async (source_dirs) => {
-                const workspace_folders = vscode.workspace.workspaceFolders ?? [];
-                const workspace_dirs_to_add: { uri: vscode.Uri; name?: string | undefined }[] = [];
-
-                for (const source_dir of source_dirs) {
-                    const source_dir_uri = vscode.Uri.parse(source_dir.uri);
-                    const source_dir_path = source_dir_uri.path;
-
-                    const is_subdirectory = (dir: string, parent: string) => {
-                        //  Use lower-case on Windows since drives can be specified in VS Code
-                        //  either with lower or upper case characters.
-                        if (process.platform == 'win32') {
-                            dir = dir.toLowerCase();
-                            parent = parent.toLowerCase();
-                        }
+    const foldersInSettings = vscode.workspace.getConfiguration().get('folders') ?? [];
+
+    //  Don't propose any popup if we multi-root workspace folders are already set
+    //  explicitly in the workspace's settings.
+    if (foldersInSettings !== undefined) {
+        const sourceDirs: ALSSourceDirDescription[] = (await alsClient.sendRequest(
+            ExecuteCommandRequest.type,
+            {
+                command: 'als-source-dirs',
+            }
+        )) as ALSSourceDirDescription[];
+
+        const isSubdirectory = (dir: string, parent: string) => {
+            //  Use lower-case on Windows since drives can be specified in VS Code
+            //  either with lower or upper case characters.
+            if (process.platform == 'win32') {
+                dir = dir.toLowerCase();
+                parent = parent.toLowerCase();
+            }
+
+            return dir.startsWith(parent + '/');
+        };
+
+        const workspaceFolders = vscode.workspace.workspaceFolders ?? [];
+        const workspaceDirsToAdd: { uri: vscode.Uri; name?: string | undefined }[] = [];
+
+        for (const source_dir of sourceDirs) {
+            const sourceDirURI = vscode.Uri.parse(source_dir.uri);
+            const sourceDirPath = sourceDirURI.path;
+
+            //  If the source directory is not under one of the workspace folders and
+            //  if it's not already present in the workspace's folders, push
+            //  this source directory to the workspace folders to add later.
+            if (
+                !workspaceFolders.some(
+                    (workspaceFolder) =>
+                        workspaceFolder.uri.path == sourceDirPath ||
+                        isSubdirectory(sourceDirPath, workspaceFolder.uri.path)
+                )
+            ) {
+                workspaceDirsToAdd.push({
+                    name: source_dir.name,
+                    uri: sourceDirURI,
+                });
+            }
+        }
 
-                        return dir.startsWith(parent + '/');
-                    };
-
-                    //  If the source directory is not under one of the workspace folders, push
-                    //  this source directory to the workspace folders to add later.
-                    if (
-                        !workspace_folders.some((workspace_folder) =>
-                            is_subdirectory(source_dir_path, workspace_folder.uri.path)
-                        )
-                    ) {
-                        workspace_dirs_to_add.push({
-                            name: source_dir.name,
-                            uri: source_dir_uri,
-                        });
+        //  If there are some source directories missing in the workspace, ask the user
+        //  to add them in his workspace.
+        if (workspaceDirsToAdd.length > 0) {
+            await vscode.window
+                .showInformationMessage(
+                    'Some project source directories are not \
+                    listed in your workspace: do you want to add them?',
+                    'Yes',
+                    'No'
+                )
+                .then((answer) => {
+                    if (answer === 'Yes') {
+                        for (const workspaceDir of workspaceDirsToAdd) {
+                            vscode.workspace.updateWorkspaceFolders(
+                                vscode.workspace.workspaceFolders
+                                    ? vscode.workspace.workspaceFolders.length
+                                    : 0,
+                                null,
+                                workspaceDir
+                            );
+                        }
                     }
-                }
-
-                //  If there are some source directories missing in the workspace, ask the user
-                //  to add them in his workspace.
-                if (workspace_dirs_to_add.length > 0) {
-                    await vscode.window
-                        .showInformationMessage(
-                            'Some project source directories are not ',
-                            'listed in your workspace: do you want to add them?',
-                            'Yes',
-                            'No'
-                        )
-                        .then((answer) => {
-                            if (answer === 'Yes') {
-                                for (const workspace_dir of workspace_dirs_to_add) {
-                                    vscode.workspace.updateWorkspaceFolders(
-                                        vscode.workspace.workspaceFolders
-                                            ? vscode.workspace.workspaceFolders.length
-                                            : 0,
-                                        null,
-                                        workspace_dir
-                                    );
-                                }
-                            }
-                        });
-                }
-            });
+                });
+        }
     }
 }

source/ada/lsp-ada_driver.adb

@@ -60,6 +60,7 @@ with LSP.Ada_Handlers.Refactor.Replace_Type;
 with LSP.Ada_Handlers.Refactor.Sort_Dependencies;
 with LSP.Ada_Handlers.Refactor.Suppress_Seperate;
 with LSP.Ada_Handlers.Show_Dependencies_Commands;
+with LSP.Ada_Handlers.Source_Dirs_Commands;
 with LSP.Ada_Handlers.Suspend_Executions;
 with LSP.GNATCOLL_Trace_Streams;
 with LSP.GNATCOLL_Tracers;
@@ -95,6 +96,8 @@ procedure LSP.Ada_Driver is
         (LSP.Ada_Handlers.Project_Reload_Commands.Command'Tag);
       LSP.Ada_Commands.Register
         (LSP.Ada_Handlers.Show_Dependencies_Commands.Command'Tag);
+      LSP.Ada_Commands.Register
+        (LSP.Ada_Handlers.Source_Dirs_Commands.Command'Tag);
       LSP.Ada_Commands.Register
         (LSP.Ada_Handlers.Executables_Commands.Command'Tag);
       LSP.Ada_Commands.Register

source/ada/lsp-ada_handlers-source_dirs_commands.adb

@@ -0,0 +1,79 @@
+------------------------------------------------------------------------------
+--                         Language Server Protocol                         --
+--                                                                          --
+--                        Copyright (C) 2020-2023, AdaCore                  --
+--                                                                          --
+-- This is free software;  you can redistribute it  and/or modify it  under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  This software is distributed in the hope  that it will be useful, --
+-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for  more details.  You should have  received  a copy of the GNU --
+-- General  Public  License  distributed  with  this  software;   see  file --
+-- COPYING3.  If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license.                                                          --
+------------------------------------------------------------------------------
+
+with VSS.JSON.Streams;
+with VSS.Strings.Conversions;
+with GNATCOLL.VFS; use GNATCOLL.VFS;
+with URIs;
+
+package body LSP.Ada_Handlers.Source_Dirs_Commands is
+
+   ------------
+   -- Create --
+   ------------
+
+   overriding function Create
+     (Any : not null access LSP.Structures.LSPAny_Vector)
+       return Command is
+   begin
+      --  We have no arguments for this command
+      return V : Command;
+   end Create;
+
+   -------------
+   -- Execute --
+   -------------
+
+   overriding procedure Execute
+     (Self     : Command;
+      Handler  : not null access LSP.Ada_Handlers.Message_Handler'Class;
+      Response : in out LSP.Structures.LSPAny_Or_Null;
+      Error    : in out LSP.Errors.ResponseError_Optional)
+   is
+      procedure Append (Item : VSS.JSON.Streams.JSON_Stream_Element);
+
+      ------------
+      -- Append --
+      ------------
+
+      procedure Append (Item : VSS.JSON.Streams.JSON_Stream_Element) is
+      begin
+         Response.Value.Append (Item);
+      end Append;
+
+      Source_Dirs : constant GNATCOLL.VFS.File_Array :=
+        Handler.Contexts.All_Source_Directories
+          (Include_Externally_Built => True);
+   begin
+      Response := (Is_Null => False, Value => <>);
+      Append ((Kind => VSS.JSON.Streams.Start_Array));
+
+      for Dir of Source_Dirs loop
+         Append ((Kind => VSS.JSON.Streams.Start_Object));
+         Append ((VSS.JSON.Streams.Key_Name, "name"));
+         Append ((VSS.JSON.Streams.String_Value, VSS.Strings.Conversions.To_Virtual_String
+            (Dir.Display_Base_Dir_Name)));
+         Append ((VSS.JSON.Streams.Key_Name, "uri"));
+         Append ((VSS.JSON.Streams.String_Value,  VSS.Strings.Conversions.To_Virtual_String
+            (URIs.Conversions.From_File (Dir.Display_Full_Name))));
+         Append ((Kind => VSS.JSON.Streams.End_Object));
+      end loop;
+
+      Append ((Kind => VSS.JSON.Streams.End_Array));
+   end Execute;
+
+end LSP.Ada_Handlers.Source_Dirs_Commands;

source/ada/lsp-ada_handlers-source_dirs_commands.ads

@@ -0,0 +1,44 @@
+------------------------------------------------------------------------------
+--                         Language Server Protocol                         --
+--                                                                          --
+--                        Copyright (C) 2020-2023, AdaCore                  --
+--                                                                          --
+-- This is free software;  you can redistribute it  and/or modify it  under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  This software is distributed in the hope  that it will be useful, --
+-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
+-- License for  more details.  You should have  received  a copy of the GNU --
+-- General  Public  License  distributed  with  this  software;   see  file --
+-- COPYING3.  If not, go to http://www.gnu.org/licenses for a complete copy --
+-- of the license.                                                          --
+------------------------------------------------------------------------------
+
+--  Implementation of the command to get list of the project's source
+--  directories.
+
+with LSP.Ada_Commands;
+with LSP.Errors;
+
+package LSP.Ada_Handlers.Source_Dirs_Commands is
+
+   type Command is new LSP.Ada_Commands.Command with private;
+
+private
+
+   type Command is new LSP.Ada_Commands.Command with null record;
+
+   overriding function Create
+     (Any : not null access LSP.Structures.LSPAny_Vector)
+       return Command;
+
+   overriding procedure Execute
+     (Self     : Command;
+      Handler  : not null access LSP.Ada_Handlers.Message_Handler'Class;
+      Response : in out LSP.Structures.LSPAny_Or_Null;
+      Error    : in out LSP.Errors.ResponseError_Optional);
+
+   for Command'External_Tag use "als-source-dirs";
+
+end LSP.Ada_Handlers.Source_Dirs_Commands;

source/ada/lsp-ada_handlers.adb

@@ -3351,7 +3351,6 @@ package body LSP.Ada_Handlers is
             Call_Hierarchy.Find_Incoming_Calls
               (Self, Response, Filter, C, Definition);
          end if;
-
       end Process_Context;
 
    begin
@@ -3751,14 +3750,21 @@ package body LSP.Ada_Handlers is
                Node : constant Libadalang.Analysis.Defining_Name :=
                  Decl.P_Defining_Name;
 
+               --  In case the Defining_Name is a Dotted_Name then we need
+               --  to point to the func which is the last.
                Location : constant LSP.Structures.Location :=
-                 Self.To_LSP_Location (Node);
+                 Self.To_LSP_Location
+                   (if Node.First_Child.Kind
+                       in Libadalang.Common.Ada_Dotted_Name_Range
+                    then Node.First_Child.As_Dotted_Name.F_Suffix
+                    else Node);
 
                Item : constant LSP.Structures.CallHierarchyItem :=
                  (name           => VSS.Strings.To_Virtual_String (Node.Text),
                   kind           => Utils.Get_Decl_Kind (Decl),
                   tags           => <>,
-                  detail         => Utils.Node_Location_Image (Node),
+                  detail         =>
+                    Utils.Node_Location_Image (Node),
                   uri            => Location.uri,
                   a_range        => Span,
                   selectionRange => Location.a_range,

testsuite/ada_lsp/called_by.subunit/src/main.adb

@@ -0,0 +1,7 @@
+with Root.Child;
+with Root.Child.Do_Something;
+procedure Main is
+begin
+   Root.Child.Do_Something;
+   Root.Child.Hello;
+end Main;

testsuite/ada_lsp/called_by.subunit/src/root-child-do_something.adb

@@ -0,0 +1,4 @@
+procedure Root.Child.Do_Something is
+begin
+   null;
+end Root.Child.Do_Something;

testsuite/ada_lsp/called_by.subunit/src/root-child.ads

@@ -0,0 +1,5 @@
+package Root.Child is
+
+   procedure Hello is null;
+
+end Root.Child;

testsuite/ada_lsp/called_by.subunit/src/root.ads

@@ -0,0 +1,3 @@
+package Root is
+
+end Root;

testsuite/ada_lsp/called_by.subunit/test.gpr

@@ -0,0 +1,4 @@
+project Test is
+    for Source_Dirs use ("src");
+    for Main use ("main.adb");
+end Test;