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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125 | -- Test that Libadalang's project unit provider behaves as expected. First
-- check that unsupported projects are properly rejected, then load a
-- supported one an check that name resolution properly uses it.
with Ada.Exceptions;
with Ada.Text_IO; use Ada.Text_IO;
with GPR2.Path_Name;
with GPR2.Project.Tree;
with GPR2.Context;
with GPR2.Project.View; use GPR2.Project.View;
with Libadalang.Analysis; use Libadalang.Analysis;
with Libadalang.Common; use Libadalang.Common;
with Libadalang.Iterators; use Libadalang.Iterators;
with Libadalang.GPR2_Provider; use Libadalang.GPR2_Provider;
with GNAT.Traceback.Symbolic;
procedure Main is
Tree : GPR2.Project.Tree.Object;
function Load_Project
(File : GPR2.Filename_Type; Project : GPR2.Optional_Name_Type := "")
return Unit_Provider_Reference;
procedure Try_Loading_Project (File : String; Project : String := "");
------------------
-- Load_Project --
------------------
function Load_Project
(File : GPR2.Filename_Type; Project : GPR2.Optional_Name_Type := "")
return Unit_Provider_Reference
is
use type GPR2.Optional_Name_Type;
Prj : GPR2.Project.View.Object := Undefined;
begin
Put_Line ("Loading " & String (File) & "...");
if Project'Length > 0 then
Put_Line (" Targetting subproject " & String (Project));
end if;
Tree.Load_Autoconf
(Filename => GPR2.Path_Name.Create_File (File),
Context => GPR2.Context.Empty);
Tree.Update_Sources;
if Project'Length > 0 then
for V of Tree.Ordered_Views loop
if V.Name = Project then
Prj := V;
exit;
end if;
end loop;
pragma Assert (Prj.Is_Defined);
end if;
return Create_Project_Unit_Provider (Tree, Prj);
exception
when others =>
Prj := Undefined;
Tree.Unload;
raise;
end Load_Project;
-------------------------
-- Try_Loading_Project --
-------------------------
procedure Try_Loading_Project (File : String; Project : String := "") is
Dummy : Unit_Provider_Reference;
begin
Dummy := Load_Project
(GPR2.Filename_Type (File),
GPR2.Optional_Name_Type (Project));
Tree.Unload;
Put_Line (" Success");
exception
when Exc : GPR2.Project_Error =>
Put_Line (" Invalid_Project exception: "
& Ada.Exceptions.Exception_Message (Exc));
when Exc : Unsupported_View_Error =>
Put_Line (" Unsupported_View_Error exception: "
& Ada.Exceptions.Exception_Message (Exc));
end Try_Loading_Project;
begin
Try_Loading_Project ("unsupported_aggr.gpr");
Try_Loading_Project ("unsupported_aggr.gpr", "unsupported_aggr");
Try_Loading_Project ("unsupported_aggr.gpr", "p");
Try_Loading_Project ("supported_no_conflict.gpr");
Try_Loading_Project ("supported_simple_aggr.gpr");
Try_Loading_Project ("supported_simple_aggr.gpr", "supported_simple_aggr");
Try_Loading_Project ("supported_chained_aggr.gpr");
Try_Loading_Project ("supported_chained_aggr.gpr",
"supported_chained_aggr");
declare
Ctx : constant Analysis_Context :=
Create_Context (Unit_Provider => Load_Project ("p.gpr"));
Unit : constant Analysis_Unit :=
Get_From_Provider (Ctx, "p2", Unit_Specification);
Root : constant Ada_Node := Unit.Root;
Subtype_Ind : constant Subtype_Indication := Find_First
(Root, Kind_Is (Ada_Subtype_Indication)).As_Subtype_Indication;
Res_Type : constant Ada_Node_Array :=
Subtype_Ind.F_Name.P_Matching_Nodes;
begin
Put_Line (Subtype_Ind.Image & " resolves to:");
for E of Res_Type loop
Put_Line (" " & E.Image);
end loop;
end;
Put_Line ("Done.");
exception
when E : others =>
Put_Line (Ada.Exceptions.Exception_Name (E)
& ": "
& Ada.Exceptions.Exception_Message (E)
& ASCII.LF
& GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
end Main;
|