Skip to content

Commit 8d8ec3a

Browse files
committed
Merge branch 'gs_532' into 'master'
Local variables for DAP See merge request eng/ide/gnatstudio!860
2 parents 23d79b5 + c414e72 commit 8d8ec3a

12 files changed

+299
-24
lines changed

dap/src/modules/dap-modules-variables-items-arguments.adb

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -17,15 +17,15 @@
1717

1818
package body DAP.Modules.Variables.Items.Arguments is
1919

20-
------------------
21-
-- Is_Arguments --
22-
------------------
20+
----------------------
21+
-- Get_Special_Kind --
22+
----------------------
2323

24-
overriding function Is_Arguments
25-
(Info : Arguments_Item_Info) return Boolean is
24+
overriding function Get_Special_Kind
25+
(Info : Arguments_Item_Info) return Variable_Kind is
2626
begin
27-
return True;
28-
end Is_Arguments;
27+
return DAP.Types.Arguments;
28+
end Get_Special_Kind;
2929

3030
--------------
3131
-- Get_Name --

dap/src/modules/dap-modules-variables-items-arguments.ads

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -19,8 +19,8 @@ package DAP.Modules.Variables.Items.Arguments is
1919

2020
type Arguments_Item_Info is new Item_Info with null record;
2121

22-
overriding function Is_Arguments
23-
(Info : Arguments_Item_Info) return Boolean;
22+
overriding function Get_Special_Kind
23+
(Info : Arguments_Item_Info) return Variable_Kind;
2424

2525
overriding function Get_Name
2626
(Self : Arguments_Item_Info) return Virtual_String;
Lines changed: 98 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,98 @@
1+
------------------------------------------------------------------------------
2+
-- GNAT Studio --
3+
-- --
4+
-- Copyright (C) 2025, 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+
package body DAP.Modules.Variables.Items.Locals is
19+
20+
----------------------
21+
-- Get_Special_Kind --
22+
----------------------
23+
24+
overriding function Get_Special_Kind
25+
(Info : Locals_Item_Info) return Variable_Kind is
26+
begin
27+
return DAP.Types.Locals;
28+
end Get_Special_Kind;
29+
30+
--------------
31+
-- Get_Name --
32+
--------------
33+
34+
overriding function Get_Name
35+
(Self : Locals_Item_Info) return Virtual_String is
36+
begin
37+
return "Local variables";
38+
end Get_Name;
39+
40+
-------------------
41+
-- Get_Full_Name --
42+
-------------------
43+
44+
overriding function Get_Full_Name
45+
(Self : Locals_Item_Info) return Virtual_String is
46+
begin
47+
return "Local variables";
48+
end Get_Full_Name;
49+
50+
-------------------
51+
-- Find_DAP_Item --
52+
-------------------
53+
54+
overriding procedure Find_DAP_Item
55+
(Info : Locals_Item_Info;
56+
C : in out DAP.Types.Variables_References_Trees.Cursor;
57+
Found : out Boolean) is
58+
begin
59+
Found := True;
60+
end Find_DAP_Item;
61+
62+
-----------
63+
-- Store --
64+
-----------
65+
66+
overriding procedure Store
67+
(Info : Locals_Item_Info;
68+
Value : in out GNATCOLL.JSON.JSON_Value) is
69+
begin
70+
Value.Set_Field ("tag", "local variables");
71+
end Store;
72+
73+
----------
74+
-- Load --
75+
----------
76+
77+
function Load (Value : GNATCOLL.JSON.JSON_Value) return Item_Info'Class
78+
is
79+
pragma Unreferenced (Value);
80+
begin
81+
return Create;
82+
end Load;
83+
84+
------------
85+
-- Create --
86+
------------
87+
88+
function Create
89+
(Format : DAP.Tools.ValueFormat)
90+
return Item_Info'Class is
91+
begin
92+
return Item_Info'Class
93+
(Locals_Item_Info'
94+
(Format => Format,
95+
others => <>));
96+
end Create;
97+
98+
end DAP.Modules.Variables.Items.Locals;
Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,44 @@
1+
------------------------------------------------------------------------------
2+
-- GNAT Studio --
3+
-- --
4+
-- Copyright (C) 2025, 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+
package DAP.Modules.Variables.Items.Locals is
19+
20+
type Locals_Item_Info is new Item_Info with null record;
21+
22+
overriding function Get_Special_Kind
23+
(Info : Locals_Item_Info) return Variable_Kind;
24+
25+
overriding function Get_Name
26+
(Self : Locals_Item_Info) return Virtual_String;
27+
28+
overriding function Get_Full_Name
29+
(Self : Locals_Item_Info) return Virtual_String;
30+
31+
overriding procedure Find_DAP_Item
32+
(Info : Locals_Item_Info;
33+
C : in out DAP.Types.Variables_References_Trees.Cursor;
34+
Found : out Boolean);
35+
36+
overriding procedure Store
37+
(Info : Locals_Item_Info;
38+
Value : in out GNATCOLL.JSON.JSON_Value);
39+
40+
function Load (Value : GNATCOLL.JSON.JSON_Value) return Item_Info'Class;
41+
42+
function Create (Format : DAP.Tools.ValueFormat) return Item_Info'Class;
43+
44+
end DAP.Modules.Variables.Items.Locals;

dap/src/modules/dap-modules-variables-items.adb

Lines changed: 11 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ with VSS.Strings.Conversions;
2222
with DAP.Modules.Variables.Items.Variables;
2323
with DAP.Modules.Variables.Items.Commands;
2424
with DAP.Modules.Variables.Items.Arguments;
25+
with DAP.Modules.Variables.Items.Locals;
2526

2627
package body DAP.Modules.Variables.Items is
2728

@@ -92,6 +93,7 @@ package body DAP.Modules.Variables.Items is
9293
Command : VSS.Strings.Virtual_String := "";
9394
Split_Lines : Boolean := False;
9495
Arguments : Boolean := False;
96+
Locals : Boolean := False;
9597
Format : DAP.Tools.ValueFormat := Default_Format)
9698
return Item_Info'Class is
9799
begin
@@ -106,19 +108,22 @@ package body DAP.Modules.Variables.Items is
106108
elsif Arguments then
107109
return DAP.Modules.Variables.Items.Arguments.Create (Format);
108110

111+
elsif Locals then
112+
return DAP.Modules.Variables.Items.Locals.Create (Format);
113+
109114
else
110115
return No_Item;
111116
end if;
112117
end Create;
113118

114-
------------------
115-
-- Is_Arguments --
116-
------------------
119+
----------------------
120+
-- Get_Special_Kind --
121+
----------------------
117122

118-
function Is_Arguments (Info : Item_Info) return Boolean is
123+
function Get_Special_Kind (Info : Item_Info) return Variable_Kind is
119124
begin
120-
return False;
121-
end Is_Arguments;
125+
return Non_Specified;
126+
end Get_Special_Kind;
122127

123128
----------------
124129
-- Is_Command --

dap/src/modules/dap-modules-variables-items.ads

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -72,9 +72,9 @@ package DAP.Modules.Variables.Items is
7272
function Is_Command (Info : Item_Info) return Boolean;
7373
-- Returns True if the item corresponds to a command
7474

75-
function Is_Arguments (Info : Item_Info) return Boolean;
76-
-- Returns True if the item corresponds to "arguments" item that is used
77-
-- for "display arguments" action
75+
function Get_Special_Kind (Info : Item_Info) return Variable_Kind;
76+
-- Returns Item special type if the item corresponds to "arguments/locals"
77+
-- item that is used for "display arguments/locals" action
7878

7979
function Is_No_Item (Info : Item_Info) return Boolean;
8080
-- Returns True if the item has no data and used to indicate that
@@ -101,6 +101,7 @@ package DAP.Modules.Variables.Items is
101101
Command : VSS.Strings.Virtual_String := "";
102102
Split_Lines : Boolean := False;
103103
Arguments : Boolean := False;
104+
Locals : Boolean := False;
104105
Format : DAP.Tools.ValueFormat := Default_Format)
105106
return Item_Info'Class;
106107
-- Returns corresponding Item_Info

dap/src/modules/dap-views-variables.adb

Lines changed: 53 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -146,6 +146,11 @@ package body DAP.Views.Variables is
146146
(Command : access Display_Arguments_Command;
147147
Context : Interactive_Command_Context) return Command_Return_Type;
148148

149+
type Display_Locals_Command is new Interactive_Command with null record;
150+
overriding function Execute
151+
(Command : access Display_Locals_Command;
152+
Context : Interactive_Command_Context) return Command_Return_Type;
153+
149154
type Access_Variable_Filter is
150155
new Action_Filter_Record with null record;
151156
overriding function Filter_Matches_Primitive
@@ -841,7 +846,7 @@ package body DAP.Views.Variables is
841846
then Item.Get_Full_Name
842847
else Var.name)) &
843848
Var_Id'Img &
844-
" " & Item.Is_Arguments'Img);
849+
" " & Item.Get_Special_Kind'Img);
845850

846851
if Parent /= Null_Iter then
847852
Self.Remove_Dummy_Child (Parent);
@@ -879,13 +884,13 @@ package body DAP.Views.Variables is
879884
(VSS.Strings.Conversions.To_UTF_8_String (Item_Full_Name))));
880885

881886
if Cursor /= Variables_References_Trees.No_Element then
882-
if Item.Is_Arguments then
887+
if Item.Get_Special_Kind /= Non_Specified then
883888
pragma Assert (Cursor.Is_Root);
884889

885-
-- Fill `arguments` node
890+
-- Fill `special` (arguments/locals) node
886891
C := Cursor.First_Child;
887892
while C.Has_Element loop
888-
if Element (C).Kind = DAP.Types.Arguments then
893+
if Element (C).Kind = Item.Get_Special_Kind then
889894
Self.Add_Row
890895
(Item => No_Item, Cursor => C, Parent => Row);
891896
end if;
@@ -1386,13 +1391,15 @@ package body DAP.Views.Variables is
13861391
(Self : access DAP_Variables_View_Record'Class;
13871392
Item : Item_Info'Class) is
13881393
begin
1389-
if Item.Is_Arguments then
1394+
if Item.Get_Special_Kind /= Non_Specified then
13901395
declare
13911396
Curs : Item_Info_Vectors.Cursor;
13921397
begin
13931398
Curs := Self.Tree.Items.First;
13941399
while Item_Info_Vectors.Has_Element (Curs) loop
1395-
if Item_Info_Vectors.Element (Curs).Is_Arguments then
1400+
if Item_Info_Vectors.Element (Curs).Get_Special_Kind =
1401+
Item.Get_Special_Kind
1402+
then
13961403
Self.Tree.Items.Delete (Curs);
13971404
exit;
13981405
end if;
@@ -1827,6 +1834,36 @@ package body DAP.Views.Variables is
18271834
-- Execute --
18281835
-------------
18291836

1837+
overriding function Execute
1838+
(Command : access Display_Locals_Command;
1839+
Context : Interactive_Command_Context) return Command_Return_Type
1840+
is
1841+
pragma Unreferenced (Command);
1842+
use type DAP.Clients.DAP_Client_Access;
1843+
1844+
Client : constant DAP.Clients.DAP_Client_Access :=
1845+
DAP.Module.Get_Current_Debugger;
1846+
View : DAP_Variables_View;
1847+
begin
1848+
if Client /= null then
1849+
View := Get_Or_Create_View (Client.Kernel, Client);
1850+
if View /= null then
1851+
declare
1852+
It : Item_Info'Class := DAP.Modules.Variables.Items.Create
1853+
(Locals => True);
1854+
begin
1855+
View.Display (It);
1856+
end;
1857+
end if;
1858+
end if;
1859+
1860+
return Commands.Success;
1861+
end Execute;
1862+
1863+
-------------
1864+
-- Execute --
1865+
-------------
1866+
18301867
overriding function Execute
18311868
(Command : access Tree_Undisplay_Command;
18321869
Context : Interactive_Command_Context) return Command_Return_Type
@@ -2465,6 +2502,16 @@ package body DAP.Views.Variables is
24652502
Filter => Debugger_Stopped_Filter,
24662503
Icon_Name => "gps-debugger-arguments-symbolic",
24672504
Category => "Debug");
2505+
2506+
Register_Action
2507+
(Kernel, "debug tree display local variables",
2508+
Command => new Display_Locals_Command,
2509+
Description =>
2510+
"Display the local variables in the Variables view",
2511+
Filter => Debugger_Stopped_Filter,
2512+
Icon_Name => "gps-debugger-local-vars-symbolic",
2513+
Category => "Debug");
2514+
24682515
end Register_Module;
24692516

24702517
end DAP.Views.Variables;
Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
with Ada.Text_IO;
2+
with GNATCOLL.Symbols;
3+
4+
procedure Main is
5+
6+
Foo : String := "Hello World!";
7+
8+
Bar : array (1 .. 10) of Character := (others => 'a');
9+
10+
I : Integer := 1;
11+
12+
begin
13+
Ada.Text_IO.Put_Line (Foo);
14+
end Main;
Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
with "gnatcoll";
2+
3+
project Prj is
4+
5+
for Object_Dir use "obj";
6+
for Main use ("main.adb");
7+
8+
package Builder is
9+
for Switches ("ada") use ("-g");
10+
end Builder;
11+
12+
end Prj;
13+
Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
v="$(gdb -v | head -n 1 | cut -c 14-16)"
2+
if [ $v -ge 15 ]
3+
then
4+
mkdir obj
5+
$GPS -Pprj --load=test.py --traceon=GPS.DEBUGGING.DAP_MODULE --traceon=MODULE.Debugger_DAP --traceoff=GPS.DAP.VARIABLES --traceoff=DAP.CLIENTS.VARIABLES --traceoff=DAP.VARIABLES_REQUEST
6+
rm -r obj
7+
fi

0 commit comments

Comments
 (0)