1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with GNATCOLL.Xref; use GNATCOLL.Xref;
with GNATCOLL.SQL.Sqlite; use GNATCOLL.SQL.Sqlite;
with GNATCOLL.Projects; use GNATCOLL.Projects;
with GNATCOLL.VFS; use GNATCOLL.VFS;
with GNATCOLL.Traces; use GNATCOLL.Traces;
with GNAT.Strings; use GNAT.Strings;
procedure Query is
Tree : Project_Tree;
DB : aliased Xref_Database;
Error : String_Access;
procedure Do_Test (Name : String; Line : Natural);
procedure Do_Test (Name : String; Line : Natural) is
Curs : Entities_Cursor;
Ref : Entity_Reference;
Ent : Entity_Information;
begin
Ref := DB.Get_Entity (Name, Create ("parent.ads"), Line);
DB.Methods (Ref.Entity, Cursor => Curs, Include_Inherited => False);
while Has_Element (Curs) loop
Ent := Element (Curs);
Put_Line ("Methods of " & Name & " (non-inherited): "
& To_String (DB.Declaration (Ent).Name));
Next (Curs);
end loop;
DB.Methods (Ref.Entity, Cursor => Curs, Include_Inherited => True);
while Has_Element (Curs) loop
Ent := Element (Curs);
Put_Line ("Methods of " & Name & " (with inherited): "
& To_String (DB.Declaration (Ent).Name));
Next (Curs);
end loop;
end Do_Test;
begin
GNATCOLL.Traces.Parse_Config_File;
Load (Tree, Create ("default.gpr"));
DB.Setup_DB (Setup (":memory:"), Error);
DB.Parse_All_LI_Files
(Tree, Root_Project (Tree), Parse_Runtime_Files => False);
Do_Test ("Root", 2);
Do_Test ("DT", 7);
end Query;
|
