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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
with GNATCOLL.Projects; use GNATCOLL.Projects;
with GNATCOLL.SQL.Sessions; use GNATCOLL.SQL.Sessions;
with GNATCOLL.SQL.Sqlite;
with GNATCOLL.SQL.Exec; use GNATCOLL.SQL.Exec;
with GNATCOLL.Traces; use GNATCOLL.Traces;
with GNATCOLL.VFS; use GNATCOLL.VFS;
with GNATCOLL.Xref; use GNATCOLL.Xref;
with GNAT.Strings; use GNAT.Strings;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with GNAT.IO;
procedure Test_Method is
Session : Session_Type;
Dbase : GNATCOLL.Xref.Xref_Database;
Tree : aliased Project_Tree;
Env : Project_Environment_Access;
Error : GNAT.Strings.String_Access;
procedure Compute
(Self : Xref_Database'Class;
Entity : Entity_Information;
Cursor : out References_Cursor'Class)
is
pragma Unreferenced (Cursor);
begin
GNAT.IO.Put_Line ('#' & Overview (Self, Entity));
end Compute;
begin
if False then
GNATCOLL.Traces.Parse_Config_File ("../gnatdebug");
end if;
-- Open the database
Initialize (Env);
Tree.Load (Create ("default.gpr"),
Env => Env,
Errors => GNAT.IO.Put_Line'Access);
Dbase.Setup_DB
(DB => GNATCOLL.SQL.Sqlite.Setup (":memory:"),
Tree => Tree'Unchecked_Access,
Error => Error);
Dbase.Parse_All_LI_Files
(Tree => Tree,
Project => Tree.Root_Project,
Parse_Runtime_Files => False);
-- Display all the possible targets of a dispatching call
declare
Ref : Entity_Reference;
Cursor : Recursive_Entities_Cursor;
Prim_Decl : GNATCOLL.Xref.Entity_Declaration;
Typs : Entities_Cursor;
begin
Ref := Get_Entity (Dbase, "Prim", "main.adb", Tree.Root_Project, 7, 7);
GNAT.IO.Put_Line ("# Entity: " & Image (Dbase, Ref));
GNAT.IO.Put_Line ("# Kind: " & To_String (Ref.Kind));
GNAT.IO.Put_Line ("#Overview: " & Overview (Dbase, Ref.Entity));
Dbase.Method_Of (Ref.Entity, Typs);
while Has_Element (Typs) loop
GNAT.IO.Put_Line ("#Method_Of: " & Dbase.Overview (Element (Typs)));
Next (Typs);
end loop;
GNAT.IO.Put_Line ("#-- ");
Recursive
(Self => Dbase'Unrestricted_Access,
Entity => Ref.Entity,
Compute => Overridden_By'Unrestricted_Access,
Cursor => Cursor);
while Cursor.Has_Element loop
GNAT.IO.Put_Line ("#");
GNAT.IO.Put_Line ('#' & Dbase.Overview (Cursor.Element));
Dbase.Method_Of (Cursor.Element, Typs);
while Has_Element (Typs) loop
GNAT.IO.Put_Line ("#Method_Of: " & Dbase.Overview (Element (Typs)));
Next (Typs);
end loop;
Cursor.Next;
end loop;
GNAT.IO.Put_Line ("#-- end of program");
end;
end Test_Method;
|
