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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
------------------------------------------------------------------------------
-- --
-- GNATELIM COMPONENTS --
-- --
-- A S I S . E X T E N S I O N S . H O M O N Y M S --
-- --
-- P a c k a g e B o d y --
-- --
-- --
-- Copyright (C) 2002-2003 Ada Core Technologies, Inc. --
-- --
-- GNATELIM is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 2 or (at your option) any later --
-- version. GNATELIM is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABI- --
-- LITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public Li- --
-- cense for more details. You should have received a copy of the GNU --
-- General Public License distributed with GNAT; see file COPYING. If not, --
-- write to the Free Software Foundation, 59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA. --
-- --
-- The original version of Gnatelim was developed by Alain Le Guennec --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com) --
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with Einfo; use Einfo;
with Sinfo; use Sinfo;
package body Asis.Extensions.Homonyms is
-----------------
-- Has_Homonym --
-----------------
function Has_Homonym (E : Asis.Element) return Boolean is
function Has_Homonym_Internal (Entity : Entity_Id) return Boolean;
-- Returns true if a given Entity in GNAT tree corresponds to the
-- subprogram that has a homonym in the same scope. Derived from
-- exp_dbug.adb
--------------------------
-- Has_Homonym_Internal --
--------------------------
function Has_Homonym_Internal (Entity : Entity_Id) return Boolean is
E : Entity_Id := Entity;
begin
-- If this is a child unit, we want the child
if Nkind (E) = N_Defining_Program_Unit_Name then
E := Defining_Identifier (Entity);
end if;
-- If the entity is a subprogram instance that is not a compilation
-- unit, go to the original Ada entity
if Is_Generic_Instance (E)
and then Is_Subprogram (E)
and then not Is_Compilation_Unit (Scope (E))
then
E := Related_Instance (Scope (E));
end if;
return Has_Homonym (E);
end Has_Homonym_Internal;
begin
return Has_Homonym_Internal (E.R_Node);
end Has_Homonym;
--------------------
-- Homonym_Number --
--------------------
function Homonym_Number (E : Asis.Element) return Natural is
function Homonym_Number_Internal (Entity : Entity_Id) return Natural;
-- Returns the homonym number of a given entity or zero if the entity
-- has no homonyms
-----------------------------
-- Homonym_Number_Internal --
-----------------------------
function Homonym_Number_Internal (Entity : Entity_Id) return Natural is
E : Entity_Id := Entity;
begin
-- If this is a child unit, we want the child
if Nkind (E) = N_Defining_Program_Unit_Name then
E := Defining_Identifier (Entity);
end if;
-- If the entity is a subprogram instance that is not a compilation
-- unit, go to the original Ada entity
if Is_Generic_Instance (E)
and then Is_Subprogram (E)
and then not Is_Compilation_Unit (Scope (E))
then
E := Related_Instance (Scope (E));
end if;
if Has_Homonym (E) then
declare
H : Entity_Id := Homonym (E);
Nr : Natural := 1;
begin
while Present (H) loop
if Scope (H) = Scope (E) then
Nr := Nr + 1;
end if;
H := Homonym (H);
end loop;
return Nr;
end;
else
return 0;
end if;
end Homonym_Number_Internal;
begin
return Homonym_Number_Internal (E.R_Node);
end Homonym_Number;
end Asis.Extensions.Homonyms;
|