Skip to content

Commit 4e40555

Browse files
reznikmmreznikmm
committed
Expand ${TD} with test directory.
Extend LSP tester with ability of expanding special macro in string literals os JSON test with string value test directory.
1 parent 8891346 commit 4e40555

File tree

8 files changed

+204
-10
lines changed

8 files changed

+204
-10
lines changed

‎integration/vscode/ada/package.json

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@
2626
"type": "git",
2727
"url": "https://github.com/AdaCore/ada_language_server.git"
2828
},
29-
"os": [ "linux" ],
29+
"os": [ "linux", "win32", "darwin" ],
3030
"cpu": [ "x64" ],
3131
"contributes": {
3232
"languages": [

‎source/tester/tester-macros.adb

Lines changed: 136 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,136 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2018, 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 Ada.Directories;
19+
with Ada.Strings.Fixed;
20+
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
21+
22+
package body Tester.Macros is
23+
24+
function Expand
25+
(Value : GNATCOLL.JSON.JSON_Value;
26+
Test_Dir : String) return GNATCOLL.JSON.JSON_Value;
27+
-- Expand recursively
28+
29+
function Expand
30+
(Value : GNATCOLL.JSON.JSON_Value;
31+
Test_Dir : String) return GNATCOLL.JSON.JSON_Value
32+
is
33+
procedure Each_Field
34+
(Object : in out GNATCOLL.JSON.JSON_Value;
35+
Name : String;
36+
Value : GNATCOLL.JSON.JSON_Value);
37+
-- Expand macros in given field
38+
39+
function Expand_in_String (Text : String) return Unbounded_String;
40+
-- Expand macro in given string
41+
42+
procedure Map is new GNATCOLL.JSON.Gen_Map_JSON_Object
43+
(GNATCOLL.JSON.JSON_Value);
44+
45+
----------------
46+
-- Each_Field --
47+
----------------
48+
49+
procedure Each_Field
50+
(Object : in out GNATCOLL.JSON.JSON_Value;
51+
Name : String;
52+
Value : GNATCOLL.JSON.JSON_Value) is
53+
begin
54+
Object.Set_Field (Name, Expand (Value, Test_Dir));
55+
end Each_Field;
56+
57+
----------------------
58+
-- Expand_in_String --
59+
----------------------
60+
61+
function Expand_in_String (Text : String) return Unbounded_String
62+
is
63+
Macro : constant String := "${TD}";
64+
Result : Unbounded_String;
65+
Next : Positive := 1;
66+
begin
67+
while Next < Text'Length loop
68+
declare
69+
Pos : constant Natural :=
70+
Ada.Strings.Fixed.Index (Text, Macro, Next);
71+
begin
72+
exit when Pos = 0;
73+
74+
Append (Result, Text (Next .. Pos - 1));
75+
Append (Result, Test_Dir);
76+
Next := Pos + Macro'Length;
77+
end;
78+
end loop;
79+
80+
Append (Result, Text (Next .. Text'Last));
81+
82+
return Result;
83+
end Expand_in_String;
84+
85+
begin
86+
case Value.Kind is
87+
when GNATCOLL.JSON.JSON_Null_Type |
88+
GNATCOLL.JSON.JSON_Boolean_Type |
89+
GNATCOLL.JSON.JSON_Int_Type |
90+
GNATCOLL.JSON.JSON_Float_Type =>
91+
92+
return Value;
93+
when GNATCOLL.JSON.JSON_String_Type =>
94+
95+
return GNATCOLL.JSON.Create (Expand_in_String (Value.Get));
96+
when GNATCOLL.JSON.JSON_Array_Type =>
97+
declare
98+
Result : GNATCOLL.JSON.JSON_Array;
99+
Vector : constant GNATCOLL.JSON.JSON_Array := Value.Get;
100+
begin
101+
for J in 1 .. GNATCOLL.JSON.Length (Vector) loop
102+
declare
103+
Item : constant GNATCOLL.JSON.JSON_Value :=
104+
GNATCOLL.JSON.Get (Vector, J);
105+
begin
106+
GNATCOLL.JSON.Append (Result, Expand (Item, Test_Dir));
107+
end;
108+
end loop;
109+
110+
return GNATCOLL.JSON.Create (Result);
111+
end;
112+
when GNATCOLL.JSON.JSON_Object_Type =>
113+
declare
114+
Result : GNATCOLL.JSON.JSON_Value :=
115+
GNATCOLL.JSON.Create_Object;
116+
begin
117+
Map (Value, Each_Field'Access, Result);
118+
119+
return Result;
120+
end;
121+
end case;
122+
end Expand;
123+
124+
------------
125+
-- Expand --
126+
------------
127+
128+
procedure Expand (Test : in out GNATCOLL.JSON.JSON_Value; Path : String) is
129+
Full_Name : constant String := Ada.Directories.Full_Name (Path);
130+
Directory : constant String :=
131+
Ada.Directories.Containing_Directory (Full_Name);
132+
begin
133+
Test := Expand (Test, Directory);
134+
end Expand;
135+
136+
end Tester.Macros;

‎source/tester/tester-macros.ads

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2018, 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 GNATCOLL.JSON;
19+
20+
package Tester.Macros is
21+
22+
procedure Expand
23+
(Test : in out GNATCOLL.JSON.JSON_Value;
24+
Path : String);
25+
-- Expand macros in given JSON test
26+
--
27+
-- Currently only one macro is supported:
28+
-- * ${TD} - expands with test directory, a directory of .json file
29+
30+
end Tester.Macros;

‎source/tester/tester-run.adb

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ with Ada.Strings.Unbounded;
2121
with Ada.Text_IO;
2222
with GNATCOLL.JSON;
2323

24+
with Tester.Macros;
2425
with Tester.Tests;
2526

2627
procedure Tester.Run is
@@ -54,6 +55,7 @@ begin
5455

5556
Ada.Text_IO.Close (Input);
5657
JSON := GNATCOLL.JSON.Read (Text, Arg);
58+
Tester.Macros.Expand (JSON, Arg);
5759

5860
declare
5961
Test : Tester.Tests.Test;

‎source/tester/tester-tests.adb

Lines changed: 18 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@
1616
------------------------------------------------------------------------------
1717

1818
with Ada.Command_Line;
19+
with Ada.Directories;
1920
with Ada.Text_IO;
2021
with GNAT.OS_Lib;
2122

@@ -90,19 +91,30 @@ package body Tester.Tests is
9091
(Self : in out Test'Class;
9192
Command : GNATCOLL.JSON.JSON_Value)
9293
is
94+
function Program_Name (Path : String) return String;
95+
-- Return full path to an exacutable designated by Path
96+
97+
------------------
98+
-- Program_Name --
99+
------------------
100+
101+
function Program_Name (Path : String) return String is
102+
begin
103+
if Is_Windows then
104+
return Ada.Directories.Full_Name (Path & ".exe");
105+
else
106+
return Ada.Directories.Full_Name (Path);
107+
end if;
108+
end Program_Name;
109+
93110
Cmd : constant GNATCOLL.JSON.JSON_Array := Command.Get ("cmd");
94111
Args : Spawn.String_Vectors.UTF_8_String_Vector;
95112
begin
96113
for J in 2 .. GNATCOLL.JSON.Length (Cmd) loop
97114
Args.Append (GNATCOLL.JSON.Get (Cmd, J).Get);
98115
end loop;
99116

100-
if Is_Windows then
101-
Self.Set_Program (GNATCOLL.JSON.Get (Cmd, 1).Get & ".exe");
102-
else
103-
Self.Set_Program (GNATCOLL.JSON.Get (Cmd, 1).Get);
104-
end if;
105-
117+
Self.Set_Program (Program_Name (GNATCOLL.JSON.Get (Cmd, 1).Get));
106118
Self.Set_Arguments (Args);
107119
Self.Start;
108120

‎tester.md

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -45,3 +45,10 @@ Property value - an object:
4545
Where _wait_ object is expected server answer. Each propert of this object
4646
should be in server response.
4747

48+
JSON file preprocessing
49+
-----------------------
50+
51+
Before execution Tester does some text substitution in each string literal.
52+
Each substring `${TD}` is replaced by full path of the directory where .json
53+
file is located.
54+

‎testsuite/ada_lsp/0003-get_symbols.json

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
"send": {
88
"request": {"jsonrpc":"2.0","id":0,"method":"initialize","params":{
99
"processId":1,
10-
"rootUri":"file:.",
10+
"rootUri":"file://${TD}/0003-get_symbols",
1111
"capabilities":{}}
1212
},
1313
"wait":[{ "id": 0,
@@ -40,7 +40,7 @@
4040
"method":"textDocument/didOpen",
4141
"params":{
4242
"textDocument": {
43-
"uri": "file:aaa.ads",
43+
"uri": "file://${TD}/0003-get_symbols/aaa.ads",
4444
"languageId": "ada",
4545
"version": 1,
4646
"text": "package Aaa is\n type Enum (A, B);\n Variable : Enum;\n procedure Proc is null;\n package Nested_Package is\n end Nested_Package;\nend Aaa;\n"
@@ -57,7 +57,7 @@
5757
"method":"textDocument/documentSymbol",
5858
"params":{
5959
"textDocument": {
60-
"uri": "file:aaa.ads"
60+
"uri": "file://${TD}/0003-get_symbols/aaa.ads"
6161
}
6262
}
6363
},

‎testsuite/ada_lsp/0003-get_symbols/aaa.ads

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
package Aaa is
2+
type Enum (A, B);
3+
Variable : Enum;
4+
procedure Proc is null;
5+
package Nested_Package is
6+
end Nested_Package;
7+
end Aaa;

0 commit comments

Comments
 (0)