Skip to content

Commit d432c40

Browse files
AnthonyLeonardoGracioAnthonyLeonardoGracio
committed
Handle multi-unit files for in 'als-other-file' command
Returning a proper error in that case. Add a test for it. For eng/ide/ada_language_server#1459
1 parent 2382367 commit d432c40

File tree

9 files changed

+237
-26
lines changed

9 files changed

+237
-26
lines changed

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

Lines changed: 58 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -111,31 +111,37 @@ package body LSP.Ada_Handlers.Other_File_Commands is
111111

112112
function Other_File_From_Unit
113113
(Unit : GPR2.Build.Compilation_Unit.Object)
114-
return GNATCOLL.VFS.Virtual_File;
114+
return GNATCOLL.VFS.Virtual_File;
115115
-- Return the other file, knowing that the original file was
116116
-- related to Unit.
117117
-- Return No_File if no other file has been found
118118
-- (e.g: when querying the other file of a package that has only a
119119
-- a specification file).
120120

121-
function Unit_For_File return GPR2.Build.Compilation_Unit.Object;
122-
-- Return the Unit object corresponding to File
121+
function Unit_For_File
122+
(Is_Multi_Unit : out Boolean)
123+
return GPR2.Build.Compilation_Unit.Object;
124+
-- Return the Unit object corresponding to File.
125+
-- Set Is_Multi_Unit to True if File is a multi-unit file.
123126

124127
--------------------------
125128
-- Other_File_From_Unit --
126129
--------------------------
127130

128131
function Other_File_From_Unit
129132
(Unit : GPR2.Build.Compilation_Unit.Object)
130-
return GNATCOLL.VFS.Virtual_File
133+
return GNATCOLL.VFS.Virtual_File
131134
is
132135
Spec_File : Virtual_File;
133136
Body_File : Virtual_File;
134137
begin
135-
Spec_File := (if Unit.Has_Part (S_Spec) then
136-
Unit.Spec.Source.Virtual_File else No_File);
137-
Body_File := (if Unit.Has_Part (S_Body) then
138-
Unit.Main_Body.Source.Virtual_File else No_File);
138+
Spec_File :=
139+
(if Unit.Has_Part (S_Spec) then Unit.Spec.Source.Virtual_File
140+
else No_File);
141+
Body_File :=
142+
(if Unit.Has_Part (S_Body)
143+
then Unit.Main_Body.Source.Virtual_File
144+
else No_File);
139145

140146
if File = Spec_File then
141147
return Body_File;
@@ -149,7 +155,8 @@ package body LSP.Ada_Handlers.Other_File_Commands is
149155
-------------------
150156

151157
function Unit_For_File
152-
return GPR2.Build.Compilation_Unit.Object is
158+
(Is_Multi_Unit : out Boolean)
159+
return GPR2.Build.Compilation_Unit.Object is
153160
begin
154161
-- Check in the root project's closure for a visible source
155162
-- corresponding to this file.
@@ -163,17 +170,27 @@ package body LSP.Ada_Handlers.Other_File_Commands is
163170
Unit : GPR2.Build.Compilation_Unit.Object :=
164171
GPR2.Build.Compilation_Unit.Undefined;
165172
begin
173+
Is_Multi_Unit := False;
174+
166175
-- The source is not visible from the root project (e.g:
167176
-- when querying the other file of an Ada file that
168177
-- does not belong to the loaded project).
169-
if not Visible_Source.Is_Defined then
178+
if not Visible_Source.Is_Defined
179+
or else not Visible_Source.Has_Units
180+
then
170181
return GPR2.Build.Compilation_Unit.Undefined;
171182
end if;
172183

173184
declare
185+
Index : constant GPR2.Unit_Index :=
186+
(if Visible_Source.Has_Unit_At (GPR2.No_Index)
187+
then GPR2.No_Index
188+
else GPR2.Multi_Unit_Index'First);
174189
Unit_Info : constant GPR2.Build.Unit_Info.Object :=
175-
Visible_Source.Unit;
190+
Visible_Source.Unit (Index => Index);
176191
begin
192+
Is_Multi_Unit := Index /= GPR2.No_Index;
193+
177194
if Unit_Info.Is_Defined then
178195
Unit :=
179196
View.Namespace_Roots.First_Element.Unit
@@ -188,8 +205,10 @@ package body LSP.Ada_Handlers.Other_File_Commands is
188205
end if;
189206
end Unit_For_File;
190207

191-
Unit : constant GPR2.Build.Compilation_Unit.Object := Unit_For_File;
192-
Other_File : Virtual_File;
208+
Is_Multi_Unit : Boolean;
209+
Unit : constant GPR2.Build.Compilation_Unit.Object :=
210+
Unit_For_File (Is_Multi_Unit => Is_Multi_Unit);
211+
Other_File : Virtual_File;
193212
begin
194213
Success := True;
195214

@@ -229,23 +248,26 @@ package body LSP.Ada_Handlers.Other_File_Commands is
229248
Use_Extended => True)
230249
else ".adb");
231250
begin
232-
if GNATCOLL.Utils.Ends_With
233-
(File.Display_Full_Name, Impl_Ext)
251+
if GNATCOLL.Utils.Ends_With (File.Display_Full_Name, Impl_Ext)
234252
then
235-
return GNATCOLL.VFS.Create
236-
(Full_Filename => +GNATCOLL.Utils.Replace
237-
(S => File.Display_Full_Name,
238-
Pattern => Impl_Ext,
239-
Replacement => Spec_Ext));
253+
return
254+
GNATCOLL.VFS.Create
255+
(Full_Filename =>
256+
+GNATCOLL.Utils.Replace
257+
(S => File.Display_Full_Name,
258+
Pattern => Impl_Ext,
259+
Replacement => Spec_Ext));
240260
else
241-
return GNATCOLL.VFS.Create
242-
(Full_Filename => +GNATCOLL.Utils.Replace
243-
(S => File.Display_Full_Name,
244-
Pattern => Spec_Ext,
245-
Replacement => Impl_Ext));
261+
return
262+
GNATCOLL.VFS.Create
263+
(Full_Filename =>
264+
+GNATCOLL.Utils.Replace
265+
(S => File.Display_Full_Name,
266+
Pattern => Spec_Ext,
267+
Replacement => Impl_Ext));
246268
end if;
247269
end;
248-
else
270+
elsif not Is_Multi_Unit then
249271
Other_File := Other_File_From_Unit (Unit => Unit);
250272

251273
if Other_File = No_File then
@@ -258,6 +280,16 @@ package body LSP.Ada_Handlers.Other_File_Commands is
258280
end if;
259281

260282
return Other_File;
283+
else
284+
Success := False;
285+
Error_Msg :=
286+
VSS.Strings.Conversions.To_Virtual_String
287+
("Could not find other file for '"
288+
& File.Display_Base_Name
289+
& "': this is a multi-unit file, containing both "
290+
& "the package's specification and its body.");
291+
292+
return GNATCOLL.VFS.No_File;
261293
end if;
262294
end Get_Other_File;
263295

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

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
project Multi is
2+
for Object_Dir use "obj";
3+
for Source_Dirs use ("src");
4+
for Exec_Dir use ".";
5+
for Main use ("main.adb");
6+
7+
package Naming is
8+
for Specification ("U") use "u.adb" at 1;
9+
for Body ("U") use "u.adb" at 2;
10+
for Body ("U.V") use "sep.adb" at 1;
11+
for Body ("U.W") use "sep.adb" at 2;
12+
end Naming;
13+
end Multi;

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

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
with U;
2+
with Ada;
3+
with Pkg;
4+
5+
procedure Main is
6+
begin
7+
U.V;
8+
Pkg.Foo;
9+
end Main;

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

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
package body Pkg is
2+
procedure Foo is null;
3+
end Pkg;

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

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

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

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
with Ada.Text_IO;
2+
separate (U) procedure V is
3+
begin
4+
Ada.Text_IO.Put_Line ("U.V.");
5+
end V;
6+
7+
with GNAT.Regexp;
8+
separate (U) procedure W is
9+
begin
10+
null;
11+
end W;

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

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
package U is
2+
procedure V;
3+
end U;
4+
5+
with GNAT.OS_Lib; use GNAT.OS_Lib;
6+
package body U is
7+
procedure V is separate;
8+
procedure W is separate;
9+
begin
10+
W;
11+
end U;

‎testsuite/ada_lsp/commands.other_file.multi_unit_file/test.json‎

Lines changed: 128 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,128 @@
1+
[
2+
{
3+
"comment": "Check that the 'als-other-file' command works fine with child packages"
4+
},
5+
{
6+
"start": {
7+
"cmd": ["${ALS}"]
8+
}
9+
},
10+
{
11+
"send": {
12+
"request": {
13+
"jsonrpc": "2.0",
14+
"id": 0,
15+
"method": "initialize",
16+
"params": {
17+
"processId": 1,
18+
"rootUri": "$URI{.}",
19+
"capabilities": {}
20+
}
21+
},
22+
"wait": [
23+
{
24+
"id": 0,
25+
"result": {
26+
"capabilities": {
27+
"textDocumentSync": 2,
28+
"executeCommandProvider": {
29+
"commands": ["<HAS>", "als-other-file"]
30+
}
31+
}
32+
}
33+
}
34+
]
35+
}
36+
},
37+
{
38+
"send": {
39+
"request": {
40+
"jsonrpc": "2.0",
41+
"method": "workspace/didChangeConfiguration",
42+
"params": {
43+
"settings": {
44+
"ada": {
45+
"projectFile": "$URI{multi.gpr}"
46+
}
47+
}
48+
}
49+
},
50+
"wait": [
51+
{
52+
"jsonrpc": "2.0",
53+
"id": 1,
54+
"method": "window/workDoneProgress/create",
55+
"params": {
56+
"token": "<ANY>"
57+
}
58+
}
59+
]
60+
}
61+
},
62+
{
63+
"send": {
64+
"request": {
65+
"jsonrpc": "2.0",
66+
"method": "textDocument/didOpen",
67+
"params": {
68+
"textDocument": {
69+
"uri": "$URI{u.adb}",
70+
"languageId": "ada",
71+
"version": 1,
72+
"text": "package U is\n procedure V;\nend U;\n\nwith GNAT.OS_Lib; use GNAT.OS_Lib;\npackage body U is\n procedure V is separate;\n procedure W is separate;\nbegin\n W;\nend U;\n"
73+
}
74+
}
75+
},
76+
"wait": []
77+
}
78+
},
79+
{
80+
"send": {
81+
"request": {
82+
"jsonrpc": "2.0",
83+
"id": "sw1",
84+
"method": "workspace/executeCommand",
85+
"params": {
86+
"command": "als-other-file",
87+
"arguments": [
88+
{
89+
"uri": "$URI{u.adb}"
90+
}
91+
]
92+
}
93+
},
94+
"wait": [
95+
{
96+
"error": {
97+
"code": -32603,
98+
"message": "Could not find other file for 'u.adb': this is a multi-unit file, containing both the package's specification and its body."
99+
},
100+
"id": "sw1",
101+
"jsonrpc": "2.0"
102+
}
103+
]
104+
}
105+
},
106+
{
107+
"send": {
108+
"request": {
109+
"jsonrpc": "2.0",
110+
"id": "shutdown",
111+
"method": "shutdown",
112+
"params": null
113+
},
114+
"wait": [{ "id": "shutdown", "result": null }]
115+
}
116+
},
117+
{
118+
"send": {
119+
"request": { "jsonrpc": "2.0", "method": "exit" },
120+
"wait": []
121+
}
122+
},
123+
{
124+
"stop": {
125+
"exit_code": 0
126+
}
127+
}
128+
]

‎testsuite/ada_lsp/commands.other_file.multi_unit_file/test.yaml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
title: 'commands.other_file.multi_unit_file'

0 commit comments

Comments
 (0)