Skip to content

Commit a96258e

Browse files
committed
Merge branch 'topic/master_edge_sync' into 'edge'
Sync master/edge See merge request eng/ide/ada_language_server!1181
2 parents 4c1e655 + ea8ec6e commit a96258e

File tree

10 files changed

+151
-60
lines changed

10 files changed

+151
-60
lines changed

integration/vscode/ada/src/extension.ts

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ import GnatTaskProvider from './gnatTaskProvider';
2929
import { getSubprogramSymbol } from './gnatTaskProvider';
3030
import { alsCommandExecutor } from './alsExecuteCommand';
3131
import { ALSClientFeatures } from './alsClientFeatures';
32+
import { substituteVariables } from './helpers';
3233

3334
let alsTaskProvider: vscode.Disposable[] = [
3435
vscode.tasks.registerTaskProvider(GnatTaskProvider.gnatType, new GnatTaskProvider()),
@@ -115,7 +116,12 @@ export async function activate(context: vscode.ExtensionContext): Promise<void>
115116

116117
if (custom_env) {
117118
for (const var_name in custom_env) {
118-
process.env[var_name] = custom_env[var_name];
119+
let var_value : string = custom_env[var_name];
120+
121+
// Substitute VS Code variable references that might be present
122+
// in the JSON settings configuration (e.g: "PATH": "${workspaceFolder}/obj")
123+
var_value = var_value.replace(/(\$\{.*\})/, substituteVariables)
124+
process.env[var_name] = var_value;
119125
}
120126
}
121127

integration/vscode/ada/src/gnatTaskProvider.ts

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -150,7 +150,7 @@ const knownTaskKinds: { [id: string]: TaskProperties } = {
150150
title: 'Check current file',
151151
},
152152
cleanProject: {
153-
command: commonArgs(['gprbuild']), // No -cargs -gnatef is accepted by gprclean
153+
command: commonArgs(['gprclean']), // No -cargs -gnatef is accepted by gprclean
154154
extra: undefined,
155155
title: 'Clean current project',
156156
},

integration/vscode/ada/src/helpers.ts

Lines changed: 83 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,83 @@
1+
/*----------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2021-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+
import * as vscode from 'vscode';
18+
import * as path from 'path'
19+
20+
/**
21+
* Substitue any variable reference present in the given string. VS Code
22+
* variable references are listed here:
23+
* https://code.visualstudio.com/docs/editor/variables-reference
24+
* @param str
25+
* @param recursive
26+
* @returns
27+
*/
28+
export function substituteVariables(str: string, recursive = false) {
29+
30+
let workspaces = vscode.workspace.workspaceFolders ?? [];
31+
let workspace = workspaces.length ? workspaces[0] : null;
32+
let activeEditor = vscode.window.activeTextEditor
33+
let activeFile = activeEditor?.document;
34+
let absoluteFilePath = activeFile?.uri.fsPath ?? ""
35+
36+
if (workspace != null) {
37+
str = str.replace(/\${workspaceFolder}/g, workspace?.uri.fsPath);
38+
str = str.replace(/\${workspaceFolderBasename}/g, workspace?.name);
39+
}
40+
41+
str = str.replace(/\${file}/g, absoluteFilePath);
42+
let activeWorkspace = workspace;
43+
let relativeFilePath = absoluteFilePath;
44+
for (let workspace of workspaces) {
45+
if (absoluteFilePath.replace(workspace.uri.fsPath, '') !== absoluteFilePath) {
46+
activeWorkspace = workspace;
47+
relativeFilePath = absoluteFilePath.replace(workspace.uri.fsPath, '').substr(path.sep.length);
48+
break;
49+
}
50+
}
51+
let parsedPath = path.parse(absoluteFilePath);
52+
53+
if (activeWorkspace != null) {
54+
str = str.replace(/\${fileWorkspaceFolder}/g, activeWorkspace?.uri.fsPath);
55+
}
56+
57+
str = str.replace(/\${relativeFile}/g, relativeFilePath);
58+
str = str.replace(/\${relativeFileDirname}/g, relativeFilePath.substr(0, relativeFilePath.lastIndexOf(path.sep)));
59+
str = str.replace(/\${fileBasename}/g, parsedPath.base);
60+
str = str.replace(/\${fileBasenameNoExtension}/g, parsedPath.name);
61+
str = str.replace(/\${fileExtname}/g, parsedPath.ext);
62+
str = str.replace(/\${fileDirname}/g, parsedPath.dir.substr(parsedPath.dir.lastIndexOf(path.sep) + 1));
63+
str = str.replace(/\${cwd}/g, parsedPath.dir);
64+
str = str.replace(/\${pathSeparator}/g, path.sep);
65+
66+
if (activeEditor != null) {
67+
str = str.replace(/\${lineNumber}/g, (activeEditor.selection.start.line + 1).toString());
68+
str = str.replace(/\${selectedText}/g, activeEditor.document.getText(new vscode.Range(activeEditor.selection.start, activeEditor.selection.end)));
69+
}
70+
71+
str = str.replace(/\${env:(.*?)}/g, function (variable) {
72+
return process.env[variable.match(/\${env:(.*?)}/)![1]] || '';
73+
});
74+
75+
str = str.replace(/\${config:(.*?)}/g, function (variable) {
76+
return vscode.workspace.getConfiguration().get(variable.match(/\${config:(.*?)}/)![1], '');
77+
});
78+
79+
if (recursive && str.match(/\${(workspaceFolder|workspaceFolderBasename|fileWorkspaceFolder|relativeFile|fileBasename|fileBasenameNoExtension|fileExtname|fileDirname|cwd|pathSeparator|lineNumber|selectedText|env:(.*?)|config:(.*?))}/)) {
80+
str = substituteVariables(str, recursive);
81+
}
82+
return str;
83+
}

source/ada/lsp-ada_driver.adb

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -115,6 +115,8 @@ procedure LSP.Ada_Driver is
115115
begin
116116
Trace (Server_Trace,
117117
"EXCEPTION: " & Exception_Name (E) &
118+
Ada.Characters.Latin_1.LF &
119+
"INFORMATION: " & Exception_Information (E) &
118120
Ada.Characters.Latin_1.LF &
119121
Symbolic_Traceback (E));
120122
Ada_Handler.Handle_Error;
@@ -128,6 +130,8 @@ procedure LSP.Ada_Driver is
128130
begin
129131
Trace (Server_Trace,
130132
"EXCEPTION: " & Exception_Name (E) &
133+
Ada.Characters.Latin_1.LF &
134+
"INFORMATION: " & Exception_Information (E) &
131135
Ada.Characters.Latin_1.LF &
132136
Symbolic_Traceback (E));
133137
-- An exception occurred while fuzzing: make it fatal.

source/ada/lsp-ada_handlers-alire.adb

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -358,11 +358,13 @@ package body LSP.Ada_Handlers.Alire is
358358
is
359359
use type Ada.Streams.Stream_Element_Count;
360360

361-
Data : Ada.Streams.Stream_Element_Array (1 .. 256);
362-
Last : Ada.Streams.Stream_Element_Count := 1;
361+
Data : Ada.Streams.Stream_Element_Array (1 .. 256);
362+
Last : Ada.Streams.Stream_Element_Count := 1;
363+
Success : Boolean := True;
364+
363365
begin
364366
while Last > 0 loop
365-
Self.Process.Read_Standard_Error (Data, Last);
367+
Self.Process.Read_Standard_Error (Data, Last, Success);
366368

367369
for Item of Data (1 .. Last) loop
368370
Self.Stderr.Append (Item);
@@ -379,11 +381,13 @@ package body LSP.Ada_Handlers.Alire is
379381
is
380382
use type Ada.Streams.Stream_Element_Count;
381383

382-
Data : Ada.Streams.Stream_Element_Array (1 .. 256);
383-
Last : Ada.Streams.Stream_Element_Count := 1;
384+
Data : Ada.Streams.Stream_Element_Array (1 .. 256);
385+
Last : Ada.Streams.Stream_Element_Count := 1;
386+
Success : Boolean := True;
387+
384388
begin
385389
while Last > 0 loop
386-
Self.Process.Read_Standard_Output (Data, Last);
390+
Self.Process.Read_Standard_Output (Data, Last, Success);
387391

388392
for Item of Data (1 .. Last) loop
389393
Self.Stdout.Append (Item);

source/ada/lsp-ada_handlers.adb

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,10 +17,10 @@
1717

1818
with Ada.Calendar; use Ada.Calendar;
1919
with Ada.Characters.Handling; use Ada.Characters.Handling;
20-
with Ada.Characters.Latin_1;
2120
with Ada.Characters.Wide_Wide_Latin_1;
2221
with Ada.Containers.Indefinite_Hashed_Maps;
2322
with Ada.Exceptions;
23+
with Ada.Characters.Latin_1;
2424
with Ada.Strings.Wide_Wide_Unbounded;
2525
with Ada.Strings.UTF_Encoding;
2626
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

source/ada/lsp-lal_utils.adb

Lines changed: 3 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
------------------------------------------------------------------------------
22
-- Language Server Protocol --
33
-- --
4-
-- Copyright (C) 2018-2021, AdaCore --
4+
-- Copyright (C) 2018-2023, AdaCore --
55
-- --
66
-- This is free software; you can redistribute it and/or modify it under --
77
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -31,7 +31,6 @@ with VSS.Unicode;
3131
with Langkit_Support;
3232
with Langkit_Support.Symbols; use Langkit_Support.Symbols;
3333
with Libadalang.Common; use Libadalang.Common;
34-
with Libadalang.Doc_Utils;
3534
with Libadalang.Sources;
3635

3736
with Laltools.Call_Hierarchy;
@@ -805,6 +804,8 @@ package body LSP.Lal_Utils is
805804
Doc_Text : out VSS.Strings.Virtual_String;
806805
Decl_Text : out VSS.Strings.Virtual_String)
807806
is
807+
pragma Unreferenced (Trace);
808+
808809
Options : constant
809810
GNATdoc.Comments.Options.Extractor_Options :=
810811
(Style => Style,
@@ -833,27 +834,6 @@ package body LSP.Lal_Utils is
833834
Decl_Text := Get_Decl_Text (BD);
834835
end if;
835836

836-
-- Obtain documentation via the old engine when GNATdoc fails to extract
837-
-- the comments.
838-
if Doc_Text.Is_Empty then
839-
840-
-- Property_Errors can occur when calling
841-
-- Libadalang.Doc_Utils.Get_Documentation on unsupported
842-
-- docstrings, so add an exception handler to catch them and recover.
843-
begin
844-
Doc_Text :=
845-
VSS.Strings.To_Virtual_String
846-
(Libadalang.Doc_Utils.Get_Documentation
847-
(BD).Doc.To_String);
848-
exception
849-
when Libadalang.Common.Property_Error =>
850-
Trace.Trace
851-
("Failed to compute documentation with LAL"
852-
& "(unsupported docstring) for: " & BD.Image);
853-
Doc_Text := VSS.Strings.Empty_Virtual_String;
854-
end;
855-
end if;
856-
857837
Loc_Text := LSP.Lal_Utils.Node_Location_Image (BD);
858838
end Get_Tooltip_Text;
859839

source/client/lsp-raw_clients.adb

Lines changed: 25 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -194,12 +194,16 @@ package body LSP.Raw_Clients is
194194
begin
195195
loop
196196
declare
197-
Raw : Ada.Streams.Stream_Element_Array (1 .. 1024);
198-
Last : Ada.Streams.Stream_Element_Count;
199-
Text : String (1 .. 1024) with Import, Address => Raw'Address;
197+
Raw : Ada.Streams.Stream_Element_Array (1 .. 1024);
198+
Last : Ada.Streams.Stream_Element_Count;
199+
Text : String (1 .. 1024) with Import, Address => Raw'Address;
200+
Success : Boolean := True;
201+
200202
begin
201-
Self.Client.Server.Read_Standard_Error (Raw, Last);
202-
exit when Last in 0;
203+
Self.Client.Server.Read_Standard_Error (Raw, Last, Success);
204+
205+
exit when Last < Raw'First or not Success;
206+
203207
Self.Client.On_Standard_Error_Message (Text (1 .. Natural (Last)));
204208
end;
205209
end loop;
@@ -220,18 +224,21 @@ package body LSP.Raw_Clients is
220224
begin
221225
while Rest_Length > 0 loop
222226
declare
223-
Size : constant Positive := Positive'Min (Rest_Length, 1024);
227+
Size : constant Positive := Positive'Min (Rest_Length, 1024);
224228
-- Restrict output to reasonable size to avoid stack overflow
225-
Slice : constant String := Ada.Strings.Unbounded.Slice
229+
Slice : constant String := Ada.Strings.Unbounded.Slice
226230
(Client.To_Write, Client.Written + 1, Client.Written + Size);
227-
Raw : constant Ada.Streams.Stream_Element_Array
231+
Raw : constant Ada.Streams.Stream_Element_Array
228232
(1 .. Ada.Streams.Stream_Element_Count (Size))
229233
with Import, Address => Slice'Address;
230-
Last : Natural;
234+
Last : Natural;
235+
Success : Boolean := True;
231236

232237
begin
233238
Client.Server.Write_Standard_Input
234-
(Raw, Ada.Streams.Stream_Element_Count (Last));
239+
(Raw, Ada.Streams.Stream_Element_Count (Last), Success);
240+
241+
-- ??? IO failure is not handled, should it?
235242

236243
Client.Written := Client.Written + Last;
237244
Rest_Length := Rest_Length - Last;
@@ -319,15 +326,17 @@ package body LSP.Raw_Clients is
319326
begin
320327
loop
321328
declare
322-
Raw : Ada.Streams.Stream_Element_Array (1 .. 1024);
323-
Last : Ada.Streams.Stream_Element_Count;
324-
Text : String (1 .. Raw'Length)
329+
Raw : Ada.Streams.Stream_Element_Array (1 .. 1024);
330+
Last : Ada.Streams.Stream_Element_Count;
331+
Text : String (1 .. Raw'Length)
325332
with Import, Address => Raw'Address;
326-
Start : Natural;
333+
Success : Boolean := True;
334+
Start : Natural;
335+
327336
begin
328-
Client.Server.Read_Standard_Output (Raw, Last);
337+
Client.Server.Read_Standard_Output (Raw, Last, Success);
329338

330-
exit when Last in 0;
339+
exit when Last < Raw'First or not Success;
331340

332341
Append (Client.Buffer, Text (1 .. Positive (Last)));
333342

source/tester/tester-tests.adb

Lines changed: 15 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1042,13 +1042,16 @@ package body Tester.Tests is
10421042
(Self : in out Process_Listener)
10431043
is
10441044
use type Ada.Streams.Stream_Element_Count;
1045-
Data : Ada.Streams.Stream_Element_Array (1 .. 128);
1046-
Last : Ada.Streams.Stream_Element_Count;
1047-
Ignore : Interfaces.C_Streams.size_t;
1045+
Data : Ada.Streams.Stream_Element_Array (1 .. 128);
1046+
Last : Ada.Streams.Stream_Element_Count;
1047+
Success : Boolean := True;
1048+
Ignore : Interfaces.C_Streams.size_t;
1049+
10481050
begin
10491051
loop
1050-
Self.Process.Read_Standard_Error (Data, Last);
1051-
exit when Last = 0;
1052+
Self.Process.Read_Standard_Error (Data, Last, Success);
1053+
1054+
exit when Last = 0 or not Success;
10521055

10531056
Ignore := Interfaces.C_Streams.fwrite
10541057
(Data'Address,
@@ -1066,14 +1069,16 @@ package body Tester.Tests is
10661069
(Self : in out Process_Listener)
10671070
is
10681071
use type Ada.Streams.Stream_Element_Count;
1069-
Data : Ada.Streams.Stream_Element_Array (1 .. 128);
1070-
Last : Ada.Streams.Stream_Element_Count;
1071-
Ignore : Interfaces.C_Streams.size_t;
1072+
Data : Ada.Streams.Stream_Element_Array (1 .. 128);
1073+
Last : Ada.Streams.Stream_Element_Count;
1074+
Success : Boolean := True;
1075+
Ignore : Interfaces.C_Streams.size_t;
1076+
10721077
begin
10731078
loop
1074-
Self.Process.Read_Standard_Output (Data, Last);
1079+
Self.Process.Read_Standard_Output (Data, Last, Success);
10751080

1076-
exit when Last = 0;
1081+
exit when Last = 0 or not Success;
10771082

10781083
Ignore := Interfaces.C_Streams.fwrite
10791084
(Data'Address,

testsuite/ada_lsp/T713-012.completion.generic_package/test.json

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -276,7 +276,7 @@
276276
"label": "Params of G",
277277
"kind": 15,
278278
"detail": "generic\n type Elt_Type(<>) is limited private;\n type Elt_Ptr is access all Elt_Type;\npackage G is\n type T(Length: Natural) is private;\n type T_Ptr is access all T;\nprivate\n type Elt_Array is array(Positive range <>) of Elt_Ptr;\n type T(Length: Natural) is\n\trecord\n\t Elts: Elt_Array(1..Length);\n\tend record;\nend G;",
279-
"documentation": "at g.ads (3:1)\n\nSource:",
279+
"documentation": "at g.ads (3:1)\n\nSource:\n\n@formal Elt_Type\n@formal Elt_Ptr",
280280
"sortText": "+0",
281281
"insertText": "${1:Elt_Type : type Elt_Type(<>) is limited private;}, ${2:Elt_Ptr : type Elt_Ptr is access all Elt_Type;})$0",
282282
"insertTextFormat": 2,
@@ -517,7 +517,7 @@
517517
"label": "Params of G",
518518
"kind": 15,
519519
"detail": "generic\n type Elt_Type(<>) is limited private;\n type Elt_Ptr is access all Elt_Type;\npackage G is\n type T(Length: Natural) is private;\n type T_Ptr is access all T;\nprivate\n type Elt_Array is array(Positive range <>) of Elt_Ptr;\n type T(Length: Natural) is\n\trecord\n\t Elts: Elt_Array(1..Length);\n\tend record;\nend G;",
520-
"documentation": "at g.ads (3:1)\n\nSource:",
520+
"documentation": "at g.ads (3:1)\n\nSource:\n\n@formal Elt_Type\n@formal Elt_Ptr",
521521
"sortText": "+0",
522522
"insertText": " Elt_Ptr => ${2:type Elt_Ptr is access all Elt_Type;})$0",
523523
"insertTextFormat": 2,

0 commit comments

Comments
 (0)