Skip to content

Commit 4196cd2

Browse files
author
automatic-merge
committed
Merge remote branch 'origin/master' into edge
2 parents d5ee2f1 + c94a887 commit 4196cd2

File tree

12 files changed

+827
-62
lines changed

12 files changed

+827
-62
lines changed

‎integration/vscode/ada/src/extension.ts

Lines changed: 70 additions & 59 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ import {
3131
getEvaluatedCustomEnv,
3232
setCustomEnvironment,
3333
} from './helpers';
34+
import { ExecuteCommandRequest } from 'vscode-languageclient/node';
3435

3536
const ADA_CONTEXT = 'ADA_PROJECT_CONTEXT';
3637
export let contextClients: ContextClients;
@@ -111,66 +112,76 @@ type ALSSourceDirDescription = {
111112
*
112113
*/
113114
async function checkSrcDirectories(alsClient: LanguageClient) {
114-
if (vscode.workspace.workspaceFile !== undefined) {
115-
await alsClient
116-
.sendRequest<[ALSSourceDirDescription]>('workspace/alsSourceDirs')
117-
.then(async (source_dirs) => {
118-
const workspace_folders = vscode.workspace.workspaceFolders ?? [];
119-
const workspace_dirs_to_add: { uri: vscode.Uri; name?: string | undefined }[] = [];
120-
121-
for (const source_dir of source_dirs) {
122-
const source_dir_uri = vscode.Uri.parse(source_dir.uri);
123-
const source_dir_path = source_dir_uri.path;
124-
125-
const is_subdirectory = (dir: string, parent: string) => {
126-
// Use lower-case on Windows since drives can be specified in VS Code
127-
// either with lower or upper case characters.
128-
if (process.platform == 'win32') {
129-
dir = dir.toLowerCase();
130-
parent = parent.toLowerCase();
131-
}
115+
const foldersInSettings = vscode.workspace.getConfiguration().get('folders') ?? [];
116+
117+
// Don't propose any popup if we multi-root workspace folders are already set
118+
// explicitly in the workspace's settings.
119+
if (foldersInSettings !== undefined) {
120+
const sourceDirs: ALSSourceDirDescription[] = (await alsClient.sendRequest(
121+
ExecuteCommandRequest.type,
122+
{
123+
command: 'als-source-dirs',
124+
}
125+
)) as ALSSourceDirDescription[];
126+
127+
const isSubdirectory = (dir: string, parent: string) => {
128+
// Use lower-case on Windows since drives can be specified in VS Code
129+
// either with lower or upper case characters.
130+
if (process.platform == 'win32') {
131+
dir = dir.toLowerCase();
132+
parent = parent.toLowerCase();
133+
}
134+
135+
return dir.startsWith(parent + '/');
136+
};
137+
138+
const workspaceFolders = vscode.workspace.workspaceFolders ?? [];
139+
const workspaceDirsToAdd: { uri: vscode.Uri; name?: string | undefined }[] = [];
140+
141+
for (const source_dir of sourceDirs) {
142+
const sourceDirURI = vscode.Uri.parse(source_dir.uri);
143+
const sourceDirPath = sourceDirURI.path;
144+
145+
// If the source directory is not under one of the workspace folders and
146+
// if it's not already present in the workspace's folders, push
147+
// this source directory to the workspace folders to add later.
148+
if (
149+
!workspaceFolders.some(
150+
(workspaceFolder) =>
151+
workspaceFolder.uri.path == sourceDirPath ||
152+
isSubdirectory(sourceDirPath, workspaceFolder.uri.path)
153+
)
154+
) {
155+
workspaceDirsToAdd.push({
156+
name: source_dir.name,
157+
uri: sourceDirURI,
158+
});
159+
}
160+
}
132161

133-
return dir.startsWith(parent + '/');
134-
};
135-
136-
// If the source directory is not under one of the workspace folders, push
137-
// this source directory to the workspace folders to add later.
138-
if (
139-
!workspace_folders.some((workspace_folder) =>
140-
is_subdirectory(source_dir_path, workspace_folder.uri.path)
141-
)
142-
) {
143-
workspace_dirs_to_add.push({
144-
name: source_dir.name,
145-
uri: source_dir_uri,
146-
});
162+
// If there are some source directories missing in the workspace, ask the user
163+
// to add them in his workspace.
164+
if (workspaceDirsToAdd.length > 0) {
165+
await vscode.window
166+
.showInformationMessage(
167+
'Some project source directories are not \
168+
listed in your workspace: do you want to add them?',
169+
'Yes',
170+
'No'
171+
)
172+
.then((answer) => {
173+
if (answer === 'Yes') {
174+
for (const workspaceDir of workspaceDirsToAdd) {
175+
vscode.workspace.updateWorkspaceFolders(
176+
vscode.workspace.workspaceFolders
177+
? vscode.workspace.workspaceFolders.length
178+
: 0,
179+
null,
180+
workspaceDir
181+
);
182+
}
147183
}
148-
}
149-
150-
// If there are some source directories missing in the workspace, ask the user
151-
// to add them in his workspace.
152-
if (workspace_dirs_to_add.length > 0) {
153-
await vscode.window
154-
.showInformationMessage(
155-
'Some project source directories are not ',
156-
'listed in your workspace: do you want to add them?',
157-
'Yes',
158-
'No'
159-
)
160-
.then((answer) => {
161-
if (answer === 'Yes') {
162-
for (const workspace_dir of workspace_dirs_to_add) {
163-
vscode.workspace.updateWorkspaceFolders(
164-
vscode.workspace.workspaceFolders
165-
? vscode.workspace.workspaceFolders.length
166-
: 0,
167-
null,
168-
workspace_dir
169-
);
170-
}
171-
}
172-
});
173-
}
174-
});
184+
});
185+
}
175186
}
176187
}

‎source/ada/lsp-ada_driver.adb

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -60,6 +60,7 @@ with LSP.Ada_Handlers.Refactor.Replace_Type;
6060
with LSP.Ada_Handlers.Refactor.Sort_Dependencies;
6161
with LSP.Ada_Handlers.Refactor.Suppress_Seperate;
6262
with LSP.Ada_Handlers.Show_Dependencies_Commands;
63+
with LSP.Ada_Handlers.Source_Dirs_Commands;
6364
with LSP.Ada_Handlers.Suspend_Executions;
6465
with LSP.GNATCOLL_Trace_Streams;
6566
with LSP.GNATCOLL_Tracers;
@@ -95,6 +96,8 @@ procedure LSP.Ada_Driver is
9596
(LSP.Ada_Handlers.Project_Reload_Commands.Command'Tag);
9697
LSP.Ada_Commands.Register
9798
(LSP.Ada_Handlers.Show_Dependencies_Commands.Command'Tag);
99+
LSP.Ada_Commands.Register
100+
(LSP.Ada_Handlers.Source_Dirs_Commands.Command'Tag);
98101
LSP.Ada_Commands.Register
99102
(LSP.Ada_Handlers.Executables_Commands.Command'Tag);
100103
LSP.Ada_Commands.Register

‎source/ada/lsp-ada_handlers-source_dirs_commands.adb

Lines changed: 79 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,79 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2020-2023, AdaCore --
5+
-- --
6+
-- This is free software; you can redistribute it and/or modify it under --
7+
-- terms of the GNU General Public License as published by the Free Soft- --
8+
-- ware Foundation; either version 3, or (at your option) any later ver- --
9+
-- sion. This software is distributed in the hope that it will be useful, --
10+
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
11+
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
12+
-- License for more details. You should have received a copy of the GNU --
13+
-- General Public License distributed with this software; see file --
14+
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
15+
-- of the license. --
16+
------------------------------------------------------------------------------
17+
18+
with VSS.JSON.Streams;
19+
with VSS.Strings.Conversions;
20+
with GNATCOLL.VFS; use GNATCOLL.VFS;
21+
with URIs;
22+
23+
package body LSP.Ada_Handlers.Source_Dirs_Commands is
24+
25+
------------
26+
-- Create --
27+
------------
28+
29+
overriding function Create
30+
(Any : not null access LSP.Structures.LSPAny_Vector)
31+
return Command is
32+
begin
33+
-- We have no arguments for this command
34+
return V : Command;
35+
end Create;
36+
37+
-------------
38+
-- Execute --
39+
-------------
40+
41+
overriding procedure Execute
42+
(Self : Command;
43+
Handler : not null access LSP.Ada_Handlers.Message_Handler'Class;
44+
Response : in out LSP.Structures.LSPAny_Or_Null;
45+
Error : in out LSP.Errors.ResponseError_Optional)
46+
is
47+
procedure Append (Item : VSS.JSON.Streams.JSON_Stream_Element);
48+
49+
------------
50+
-- Append --
51+
------------
52+
53+
procedure Append (Item : VSS.JSON.Streams.JSON_Stream_Element) is
54+
begin
55+
Response.Value.Append (Item);
56+
end Append;
57+
58+
Source_Dirs : constant GNATCOLL.VFS.File_Array :=
59+
Handler.Contexts.All_Source_Directories
60+
(Include_Externally_Built => True);
61+
begin
62+
Response := (Is_Null => False, Value => <>);
63+
Append ((Kind => VSS.JSON.Streams.Start_Array));
64+
65+
for Dir of Source_Dirs loop
66+
Append ((Kind => VSS.JSON.Streams.Start_Object));
67+
Append ((VSS.JSON.Streams.Key_Name, "name"));
68+
Append ((VSS.JSON.Streams.String_Value, VSS.Strings.Conversions.To_Virtual_String
69+
(Dir.Display_Base_Dir_Name)));
70+
Append ((VSS.JSON.Streams.Key_Name, "uri"));
71+
Append ((VSS.JSON.Streams.String_Value, VSS.Strings.Conversions.To_Virtual_String
72+
(URIs.Conversions.From_File (Dir.Display_Full_Name))));
73+
Append ((Kind => VSS.JSON.Streams.End_Object));
74+
end loop;
75+
76+
Append ((Kind => VSS.JSON.Streams.End_Array));
77+
end Execute;
78+
79+
end LSP.Ada_Handlers.Source_Dirs_Commands;

‎source/ada/lsp-ada_handlers-source_dirs_commands.ads

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,44 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2020-2023, AdaCore --
5+
-- --
6+
-- This is free software; you can redistribute it and/or modify it under --
7+
-- terms of the GNU General Public License as published by the Free Soft- --
8+
-- ware Foundation; either version 3, or (at your option) any later ver- --
9+
-- sion. This software is distributed in the hope that it will be useful, --
10+
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
11+
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
12+
-- License for more details. You should have received a copy of the GNU --
13+
-- General Public License distributed with this software; see file --
14+
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
15+
-- of the license. --
16+
------------------------------------------------------------------------------
17+
18+
-- Implementation of the command to get list of the project's source
19+
-- directories.
20+
21+
with LSP.Ada_Commands;
22+
with LSP.Errors;
23+
24+
package LSP.Ada_Handlers.Source_Dirs_Commands is
25+
26+
type Command is new LSP.Ada_Commands.Command with private;
27+
28+
private
29+
30+
type Command is new LSP.Ada_Commands.Command with null record;
31+
32+
overriding function Create
33+
(Any : not null access LSP.Structures.LSPAny_Vector)
34+
return Command;
35+
36+
overriding procedure Execute
37+
(Self : Command;
38+
Handler : not null access LSP.Ada_Handlers.Message_Handler'Class;
39+
Response : in out LSP.Structures.LSPAny_Or_Null;
40+
Error : in out LSP.Errors.ResponseError_Optional);
41+
42+
for Command'External_Tag use "als-source-dirs";
43+
44+
end LSP.Ada_Handlers.Source_Dirs_Commands;

‎source/ada/lsp-ada_handlers.adb

Lines changed: 9 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3351,7 +3351,6 @@ package body LSP.Ada_Handlers is
33513351
Call_Hierarchy.Find_Incoming_Calls
33523352
(Self, Response, Filter, C, Definition);
33533353
end if;
3354-
33553354
end Process_Context;
33563355

33573356
begin
@@ -3751,14 +3750,21 @@ package body LSP.Ada_Handlers is
37513750
Node : constant Libadalang.Analysis.Defining_Name :=
37523751
Decl.P_Defining_Name;
37533752

3753+
-- In case the Defining_Name is a Dotted_Name then we need
3754+
-- to point to the func which is the last.
37543755
Location : constant LSP.Structures.Location :=
3755-
Self.To_LSP_Location (Node);
3756+
Self.To_LSP_Location
3757+
(if Node.First_Child.Kind
3758+
in Libadalang.Common.Ada_Dotted_Name_Range
3759+
then Node.First_Child.As_Dotted_Name.F_Suffix
3760+
else Node);
37563761

37573762
Item : constant LSP.Structures.CallHierarchyItem :=
37583763
(name => VSS.Strings.To_Virtual_String (Node.Text),
37593764
kind => Utils.Get_Decl_Kind (Decl),
37603765
tags => <>,
3761-
detail => Utils.Node_Location_Image (Node),
3766+
detail =>
3767+
Utils.Node_Location_Image (Node),
37623768
uri => Location.uri,
37633769
a_range => Span,
37643770
selectionRange => Location.a_range,

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

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
with Root.Child;
2+
with Root.Child.Do_Something;
3+
procedure Main is
4+
begin
5+
Root.Child.Do_Something;
6+
Root.Child.Hello;
7+
end Main;

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

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
procedure Root.Child.Do_Something is
2+
begin
3+
null;
4+
end Root.Child.Do_Something;

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

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
package Root.Child is
2+
3+
procedure Hello is null;
4+
5+
end Root.Child;

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

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
package Root is
2+
3+
end Root;

‎testsuite/ada_lsp/called_by.subunit/test.gpr

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
project Test is
2+
for Source_Dirs use ("src");
3+
for Main use ("main.adb");
4+
end Test;

0 commit comments

Comments
 (0)