ada/ada_language_server
0
0
Fork 0
mirror of https://github.com/AdaCore/ada_language_server.git synced 2026-02-12 12:45:50 -08:00
Code Issues Packages Projects Releases Wiki Activity

Fix Goto Definition for entry in Protected Types

Browse Source 
Add a test.

Closes eng/ide/ada_language_server#1437
This commit is contained in:
Boulanger
2024-10-17 16:29:47 +02:00
committed by Adrien Boulanger
parent 410891ac9c
commit 745e0eeacf
5 changed files with 364 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
source/ada/lsp-ada_definition.adb
View File

@@ -122,7 +122,6 @@ package body LSP.Ada_Definition is
Manual_Fallback : Libadalang.Analysis.Defining_Name;
Definition_Node : Libadalang.Analysis.Basic_Decl;
Decl_For_Find_Overrides : Libadalang.Analysis.Basic_Decl;
Entry_Decl_Node : Libadalang.Analysis.Entry_Decl;
Ignore : Boolean;
begin
@@ -186,7 +185,37 @@ package body LSP.Ada_Definition is
-- Search for accept statements only if we are on an entry
if Definition_Node.Kind in Libadalang.Common.Ada_Entry_Decl_Range then
Entry_Decl_Node := Definition_Node.As_Entry_Decl;
declare
Entry_Decl_Node : constant Libadalang.Analysis.Entry_Decl :=
Definition_Node.As_Entry_Decl;
Entry_Parent_Node : constant Libadalang.Analysis.Basic_Decl :=
Entry_Decl_Node.P_Parent_Basic_Decl;
begin
-- P_Accept_Stmts is only valid for entries declared in tasks
if Entry_Parent_Node.Kind in
Libadalang.Common.Ada_Task_Type_Decl_Range
then
for Accept_Node of Entry_Decl_Node.P_Accept_Stmts loop
Self.Parent.Context.Append_Location
(Self.Response,
Self.Filter,
Accept_Node.F_Body_Decl.F_Name);
end loop;
-- Others entries are are handled as simple subprograms
else
declare
Other_Part_For_Decl : constant
Libadalang.Analysis.Basic_Decl :=
Laltools.Common.Find_Next_Part_For_Decl
(Definition_Node, Trace);
begin
if not Other_Part_For_Decl.Is_Null then
Other_Part := Other_Part_For_Decl.P_Defining_Name;
end if;
end;
end if;
end;
elsif Definition_Node.Kind in
Libadalang.Common.Ada_Single_Task_Type_Decl_Range |
@@ -265,15 +294,6 @@ package body LSP.Ada_Definition is
end loop;
end;
end if;
if not Entry_Decl_Node.Is_Null then
for Accept_Node of Entry_Decl_Node.P_Accept_Stmts loop
Self.Parent.Context.Append_Location
(Self.Response,
Self.Filter,
Accept_Node.F_Body_Decl.F_Name);
end loop;
end if;
end Execute_Ada_Request;
end LSP.Ada_Definition;

67
testsuite/ada_lsp/definition_protected/show_protected_objects_entries.adb Normal file
View File

@@ -0,0 +1,67 @@
with Ada.Text_IO; use Ada.Text_IO;
procedure Show_Protected_Objects_Entries is
protected Obj is
procedure Set (V : Integer);
entry Get (V : out Integer);
private
Local : Integer;
Is_Set : Boolean := False;
end Obj;
protected body Obj is
procedure Set (V : Integer) is
begin
Local := V;
Is_Set := True;
end Set;
entry Get (V : out Integer)
when Is_Set is
-- Entry is blocked until the
-- condition is true. The barrier
-- is evaluated at call of entries
-- and at exits of procedures and
-- entries. The calling task sleeps
-- until the barrier is released.
begin
V := Local;
Is_Set := False;
end Get;
end Obj;
N : Integer := 0;
task T is
entry Seize;
end T;
task body T is
begin
accept Seize;
Put_Line
("Task T will delay for 4 seconds...");
delay 4.0;
accept Seize;
Put_Line
("Task T will set Obj...");
Obj.Set (5);
accept Seize;
Put_Line
("Task T has just set Obj...");
end T;
begin
Put_Line
("Main application will get Obj...");
Obj.Get (N);
Put_Line
("Main application has retrieved Obj...");
Put_Line
("Number is: " & Integer'Image (N));
end Show_Protected_Objects_Entries;

2
testsuite/ada_lsp/definition_protected/test.gpr Normal file
View File

@@ -0,0 +1,2 @@
project Test is
end Test;

263
testsuite/ada_lsp/definition_protected/test.json Normal file
View File

@@ -0,0 +1,263 @@
[
{
"comment": [
"Test goto defintion on an entry in a protected type."
]
},
{
"start": {
"cmd": ["${ALS}"]
}
},
{
"send": {
"request": {
"jsonrpc": "2.0",
"id": 1,
"method": "initialize",
"params": {
"rootUri": "$URI{.}",
"capabilities": {}
}
},
"wait": []
}
},
{
"send": {
"request": {
"jsonrpc": "2.0",
"method": "initialized",
"params": {}
},
"wait": []
}
},
{
"send": {
"request": {
"jsonrpc": "2.0",
"method": "textDocument/didOpen",
"params": {
"textDocument": {
"uri": "$URI{show_protected_objects_entries.adb}",
"languageId": "Ada",
"version": 0,
"text": "with Ada.Text_IO; use Ada.Text_IO;\n\nprocedure Show_Protected_Objects_Entries is\n\n protected Obj is\n procedure Set (V : Integer);\n entry Get (V : out Integer);\n private\n Local : Integer;\n Is_Set : Boolean := False;\n end Obj;\n\n protected body Obj is\n procedure Set (V : Integer) is\n begin\n Local := V;\n Is_Set := True;\n end Set;\n\n entry Get (V : out Integer)\n when Is_Set is\n -- Entry is blocked until the\n -- condition is true. The barrier\n -- is evaluated at call of entries\n -- and at exits of procedures and\n -- entries. The calling task sleeps\n -- until the barrier is released.\n begin\n V := Local;\n Is_Set := False;\n end Get;\n end Obj;\n\n N : Integer := 0;\n\n task T is\n entry Seize;\n end T;\n\n task body T is\n begin\n\n accept Seize;\n Put_Line\n (\"Task T will delay for 4 seconds...\");\n delay 4.0;\n\n accept Seize;\n Put_Line\n (\"Task T will set Obj...\");\n Obj.Set (5);\n\n accept Seize;\n Put_Line\n (\"Task T has just set Obj...\");\n end T;\nbegin\n Put_Line\n (\"Main application will get Obj...\");\n Obj.Get (N);\n\n Put_Line\n (\"Main application has retrieved Obj...\");\n Put_Line\n (\"Number is: \" & Integer'Image (N));\n\nend Show_Protected_Objects_Entries;\n"
}
}
},
"wait": []
}
},
{
"send": {
"request": {
"jsonrpc": "2.0",
"id": 6,
"method": "textDocument/definition",
"params": {
"textDocument": {
"uri": "$URI{show_protected_objects_entries.adb}"
},
"position": {
"line": 6,
"character": 12
},
"alsDisplayMethodAncestryOnNavigation": "Usage_And_Abstract_Only"
}
},
"wait": [
{
"id": 6,
"result": {
"uri": "$URI{show_protected_objects_entries.adb}",
"range": {
"start": {
"line": 19,
"character": 12
},
"end": {
"line": 19,
"character": 15
}
}
}
}
]
}
},
{
"send": {
"request": {
"jsonrpc": "2.0",
"id": 9,
"method": "textDocument/definition",
"params": {
"textDocument": {
"uri": "$URI{show_protected_objects_entries.adb}"
},
"position": {
"line": 19,
"character": 12
},
"alsDisplayMethodAncestryOnNavigation": "Usage_And_Abstract_Only"
}
},
"wait": [
{
"id": 9,
"result": {
"uri": "$URI{show_protected_objects_entries.adb}",
"range": {
"start": {
"line": 6,
"character": 12
},
"end": {
"line": 6,
"character": 15
}
}
}
}
]
}
},
{
"send": {
"request": {
"jsonrpc": "2.0",
"id": 12,
"method": "textDocument/definition",
"params": {
"textDocument": {
"uri": "$URI{show_protected_objects_entries.adb}"
},
"position": {
"line": 36,
"character": 12
},
"alsDisplayMethodAncestryOnNavigation": "Usage_And_Abstract_Only"
}
},
"wait": [
{
"id": 12,
"result": [
{
"uri": "$URI{show_protected_objects_entries.adb}",
"range": {
"start": {
"line": 42,
"character": 13
},
"end": {
"line": 42,
"character": 18
}
}
},
{
"uri": "$URI{show_protected_objects_entries.adb}",
"range": {
"start": {
"line": 47,
"character": 13
},
"end": {
"line": 47,
"character": 18
}
}
},
{
"uri": "$URI{show_protected_objects_entries.adb}",
"range": {
"start": {
"line": 52,
"character": 13
},
"end": {
"line": 52,
"character": 18
}
}
}
]
}
]
}
},
{
"send": {
"request": {
"jsonrpc": "2.0",
"id": 18,
"method": "textDocument/definition",
"params": {
"textDocument": {
"uri": "$URI{show_protected_objects_entries.adb}"
},
"position": {
"line": 47,
"character": 13
},
"alsDisplayMethodAncestryOnNavigation": "Usage_And_Abstract_Only"
}
},
"wait": [
{
"id": 18,
"result": {
"uri": "$URI{show_protected_objects_entries.adb}",
"range": {
"start": {
"line": 36,
"character": 12
},
"end": {
"line": 36,
"character": 17
}
}
}
}
]
}
},
{
"send": {
"request": {
"jsonrpc": "2.0",
"method": "textDocument/didClose",
"params": {
"textDocument": {
"uri": "$URI{show_protected_objects_entries.adb}"
}
}
},
"wait": []
}
},
{
"send": {
"request": {
"jsonrpc": "2.0",
"id": 21,
"method": "shutdown"
},
"wait": [
{
"id": 21,
"result": null
}
]
}
},
{
"stop": {
"exit_code": 0
}
}
]

1
testsuite/ada_lsp/definition_protected/test.yaml Normal file
View File

@@ -0,0 +1 @@
title: 'definition_protected'