← Back to branch summary

~ubuntu-branches/debian/sid/adabrowse/sid

« back to all changes in this revision

Viewing changes to ad-crossrefs.adb

  • Committer: Bazaar Package Importer
  • Author(s): Ludovic Brenta
  • Date: 2004-02-14 13:22:40 UTC
  • Revision ID: james.westby@ubuntu.com-20040214132240-cqumhiq1677pkvzo
Tags: upstream-4.0.2
Import upstream version 4.0.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
ad-crossrefs.adb
 
1
-------------------------------------------------------------------------------
 
2
--
 
3
--  This file is part of AdaBrowse.
 
4
--
 
5
-- <STRONG>Copyright (c) 2002 by Thomas Wolf.</STRONG>
 
6
-- <BLOCKQUOTE>
 
7
--    AdaBrowse is free software; you can redistribute it and/or modify it
 
8
--    under the terms of the  GNU General Public License as published by the
 
9
--    Free Software  Foundation; either version 2, or (at your option) any
 
10
--    later version. AdaBrowse is distributed in the hope that it will be
 
11
--    useful, but <EM>without any warranty</EM>; without even the implied
 
12
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
 
13
--    See the GNU General Public License for  more details. You should have
 
14
--    received a copy of the GNU General Public License with this distribution,
 
15
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
 
16
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
 
17
--    USA.
 
18
-- </BLOCKQUOTE>
 
19
--
 
20
-- <DL><DT><STRONG>
 
21
-- Author:</STRONG><DD>
 
22
--   Thomas Wolf  (TW)
 
23
--   <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
 
24
--
 
25
-- <DL><DT><STRONG>
 
26
-- Purpose:</STRONG><DD>
 
27
--   Singled out crossreference setup from AD.Writers.</DL>
 
28
--
 
29
-- <!--
 
30
-- Revision History
 
31
--
 
32
--   20-AUG-2002   TW  Initial version.
 
33
--   27-AUG-2002   TW  Improved 'Crossref_Exp' to cater for implicitly
 
34
--                     inherited subprograms and enumeration literals for
 
35
--                     which AdaBrowse V2.13 and earlier generated empty
 
36
--                     crossrefs (<A HREF="">Name</A>). We now try to generate
 
37
--                     a crossref to the explicit declaration the item was
 
38
--                     inherited from.
 
39
--   06-JUN-2003   TW  Moved 'Set_Standard_Units' and 'Crossref_To_Unit' here
 
40
--                     from AD.Queries.
 
41
--   09-JUL-2003   TW  New operation 'Crossref_Special' for pragmas and rep
 
42
--                     clauses.
 
43
-- -->
 
44
-------------------------------------------------------------------------------
 
45
 
 
46
pragma License (GPL);
 
47
 
 
48
with Ada.Characters.Handling;
 
49
with Ada.Exceptions;
 
50
with Ada.Strings.Wide_Unbounded;
 
51
 
 
52
with Asis;
 
53
with Asis.Clauses;
 
54
with Asis.Compilation_Units;
 
55
with Asis.Declarations;
 
56
with Asis.Elements;
 
57
with Asis.Exceptions;
 
58
with Asis.Text;
 
59
 
 
60
with AD.Exclusions;
 
61
with AD.Queries;
 
62
 
 
63
with Asis2.Declarations;
 
64
with Asis2.Naming;
 
65
with Asis2.Spans;
 
66
with Asis2.Text;
 
67
with Asis2.Units;
 
68
 
 
69
package body AD.Crossrefs is
 
70
 
 
71
   package ACH  renames Ada.Characters.Handling;
 
72
   package WASU renames Ada.Strings.Wide_Unbounded;
 
73
 
 
74
   use Asis;
 
75
   use Asis.Declarations;
 
76
   use Asis.Elements;
 
77
 
 
78
   Do_Standard_Too : Boolean := False;
 
79
 
 
80
   procedure Set_Standard_Units
 
81
     (Do_Them : in Boolean)
 
82
   is
 
83
   begin
 
84
      Do_Standard_Too := Do_Them;
 
85
   end Set_Standard_Units;
 
86
 
 
87
   function Crossref_To_Unit
 
88
     (Unit : in Asis.Compilation_Unit)
 
89
     return Boolean
 
90
   is
 
91
   begin
 
92
      if Asis.Compilation_Units.Unit_Origin (Unit) /= An_Application_Unit then
 
93
         --  Non-application units.
 
94
         if not Do_Standard_Too or else
 
95
            Asis2.Units.Is_Standard (Unit)
 
96
         then
 
97
            return False;
 
98
         end if;
 
99
      end if;
 
100
      return
 
101
        not AD.Exclusions.No_XRef
 
102
              (ACH.To_String
 
103
                 (Asis2.Text.To_Lower
 
104
                    (Asis2.Naming.Full_Unit_Name (Unit))));
 
105
   end Crossref_To_Unit;
 
106
 
 
107
   function Crossref_Name
 
108
     (Name      : in     Asis.Defining_Name;
 
109
      This_Unit : in     Asis.Declaration;
 
110
      Reporter  : access AD.Messages.Error_Reporter'Class)
 
111
     return Cross_Reference
 
112
   is
 
113
      Def       : constant Defining_Name    :=
 
114
        AD.Queries.Expand_Generic (Name, Reporter);
 
115
      Decl      : constant Declaration      :=
 
116
        Asis2.Declarations.Enclosing_Declaration (Def);
 
117
      Unit      : constant Compilation_Unit :=
 
118
        Enclosing_Compilation_Unit (Def);
 
119
      Unit_Decl : constant Declaration      :=
 
120
        Unit_Declaration (Unit);
 
121
      Result    : Cross_Reference;
 
122
   begin
 
123
      Result.Ignore         := not Crossref_To_Unit (Unit);
 
124
      Result.Is_Top_Unit    := Is_Equal (Decl, Unit_Decl);
 
125
      Result.Is_Local       := Is_Equal (Unit_Decl, This_Unit);
 
126
      Result.Full_Unit_Name :=
 
127
        WASU.To_Unbounded_Wide_String (Asis2.Naming.Full_Unit_Name (Unit));
 
128
      Result.Position       := Asis2.Spans.Start (Asis2.Spans.Get_Span (Def));
 
129
      Result.Image          :=
 
130
        WASU.To_Unbounded_Wide_String
 
131
          (Asis2.Naming.Name_Definition_Image (Def));
 
132
      --  We may use the image of 'Def' even if 'Name' is the current unit's
 
133
      --  name, for in this case, Def = Name.
 
134
      return Result;
 
135
   end Crossref_Name;
 
136
 
 
137
   function Crossref_Special
 
138
     (Element   : in     Asis.Element;
 
139
      This_Unit : in     Asis.Declaration)
 
140
     return Cross_Reference
 
141
   is
 
142
      Unit      : constant Compilation_Unit :=
 
143
        Enclosing_Compilation_Unit (Element);
 
144
      Unit_Decl : constant Declaration      :=
 
145
        Unit_Declaration (Unit);
 
146
      Result    : Cross_Reference;
 
147
   begin
 
148
      Result.Ignore         := not Crossref_To_Unit (Unit);
 
149
      Result.Is_Top_Unit    := False;
 
150
      Result.Is_Local       := Is_Equal (Unit_Decl, This_Unit);
 
151
      Result.Full_Unit_Name :=
 
152
        WASU.To_Unbounded_Wide_String (Asis2.Naming.Full_Unit_Name (Unit));
 
153
      Result.Position       :=
 
154
        Asis2.Spans.Start (Asis2.Spans.Get_Span (Element));
 
155
      case Element_Kind (Element) is
 
156
         when A_Pragma =>
 
157
            Result.Image :=
 
158
              WASU.To_Unbounded_Wide_String (Pragma_Name_Image (Element));
 
159
         when A_Clause =>
 
160
            case Representation_Clause_Kind (Element) is
 
161
               when An_Attribute_Definition_Clause |
 
162
                    An_Enumeration_Representation_Clause |
 
163
                    A_Record_Representation_Clause =>
 
164
                  Result.Image :=
 
165
                    WASU.To_Unbounded_Wide_String
 
166
                      (Asis2.Naming.Name_Expression_Image
 
167
                        (Asis.Clauses.Representation_Clause_Name (Element)));
 
168
               when others =>
 
169
                  Ada.Exceptions.Raise_Exception
 
170
                    (Asis.Exceptions.ASIS_Inappropriate_Element'Identity,
 
171
                     "Unexpected rep clause kind " &
 
172
                     Representation_Clause_Kinds'Image
 
173
                       (Representation_Clause_Kind (Element)) &
 
174
                     " in AD.Crossrefs.Crossref_Special.");
 
175
            end case;
 
176
         when others =>
 
177
            Ada.Exceptions.Raise_Exception
 
178
              (Asis.Exceptions.ASIS_Inappropriate_Element'Identity,
 
179
               "Unexpected element kind " &
 
180
               Element_Kinds'Image (Element_Kind (Element)) &
 
181
               " in AD.Crossrefs.Crossref_Special.");
 
182
      end case;
 
183
      return Result;
 
184
   end Crossref_Special;
 
185
 
 
186
   function Crossref_Exp
 
187
     (Name      : in     Asis.Expression;
 
188
      This_Unit : in     Asis.Declaration;
 
189
      Reporter  : access AD.Messages.Error_Reporter'Class)
 
190
     return Cross_Reference
 
191
   is
 
192
      Def       : Defining_Name;
 
193
      Decl      : Declaration;
 
194
      True_Name : Defining_Name;
 
195
      Unit      : Asis.Compilation_Unit;
 
196
      Unit_Decl : Asis.Declaration;
 
197
      Kind      : constant Expression_Kinds := Expression_Kind (Name);
 
198
      Use_Def   : Boolean :=
 
199
        Kind = An_Identifier or else
 
200
        Kind = An_Enumeration_Literal;
 
201
   begin
 
202
      Def   := Asis2.Declarations.Name_Definition (Name);
 
203
      if Is_Nil (Def) then
 
204
         --  We may also legally get a Nil_Element here; e.g. if 'Name'
 
205
         --  refers to a dispatching call.
 
206
         return Null_Crossref;
 
207
      end if;
 
208
      Decl      := Asis2.Declarations.Enclosing_Declaration (Def);
 
209
      True_Name := AD.Queries.Expand_Generic (Def, Reporter);
 
210
      declare
 
211
         True_Decl : Asis.Declaration :=
 
212
           Asis2.Declarations.Enclosing_Declaration (True_Name);
 
213
      begin
 
214
         case Declaration_Origin (True_Decl) is
 
215
            when An_Explicit_Declaration =>
 
216
               null;
 
217
            when An_Implicit_Predefined_Declaration =>
 
218
               Use_Def := False;
 
219
               --  We couldn't generate any meaningful crossref anyway.
 
220
            when An_Implicit_Inherited_Declaration =>
 
221
               --  Oh well... let's try to find the explicit declaration from
 
222
               --  which we inherited the item. Note: it must be a function or
 
223
               --  procedure declaration, or an enumeration literal
 
224
               --  specification.
 
225
               case Declaration_Kind (True_Decl) is
 
226
                  when A_Procedure_Declaration |
 
227
                       A_Function_Declaration |
 
228
                       An_Enumeration_Literal_Specification =>
 
229
                     True_Decl :=
 
230
                       Asis2.Declarations.Real_Declaration (True_Decl);
 
231
                     if not Is_Nil (True_Decl) and then
 
232
                        not Asis.Text.Is_Nil (Asis2.Spans.Get_Span (True_Decl))
 
233
                     then
 
234
                        Decl      := True_Decl;
 
235
                        True_Name := Asis2.Naming.Get_Name (Decl);
 
236
                        --  We don't need to worry about defining expanded
 
237
                        --  names here...
 
238
                     end if;
 
239
                  when others =>
 
240
                     AD.Messages.Report_Error
 
241
                       (Reporter.all,
 
242
                        "Missing case value in AD.Crossrefs.Crossref_Exp for "
 
243
                        &
 
244
                        Asis.Declaration_Kinds'Image
 
245
                          (Declaration_Kind (True_Decl)));
 
246
               end case;
 
247
            when others =>
 
248
               null;
 
249
         end case;
 
250
      end;
 
251
 
 
252
      --  Special handling for references that go to items inside a generic
 
253
      --  formal package: if we have "with package X is new Y (<>)", and a
 
254
      --  reference such as "X.Z", we want to generate for 'Z' a reference
 
255
      --  to 'Y'!
 
256
      --
 
257
      --  ASIS-for-GNAT 3.14p returns an element that obviously has a source
 
258
      --  position that corresponds to the one in 'Y', but the enclosing
 
259
      --  unit delaration is not 'Y', but the one containing the formal
 
260
      --  package declaration of 'X'. Also, neither 'X', nor 'Y', nor 'Z'
 
261
      --  have Is_Part_Of_Instance.
 
262
      --
 
263
      --  I do not know whether or not this is a bug in ASIS-for-GNAT.
 
264
      --  Anyway, we handle this case specially here: if we find that a
 
265
      --  reference is inside a formal package, we use the corresponding
 
266
      --  generic unit to generate the cross-reference, *not* the unit
 
267
      --  containing the formal package declaration.
 
268
      declare
 
269
         Outer : Asis.Element := Enclosing_Element (Decl);
 
270
      begin
 
271
         while not Is_Nil (Outer) loop
 
272
            if Element_Kind (Outer) = A_Declaration then
 
273
               case Declaration_Kind (Outer) is
 
274
                  when A_Formal_Package_Declaration |
 
275
                       A_Formal_Package_Declaration_With_Box =>
 
276
                     exit;
 
277
                  when others =>
 
278
                     null;
 
279
               end case;
 
280
            end if;
 
281
            Outer := Enclosing_Element (Outer);
 
282
         end loop;
 
283
         if Is_Nil (Outer) then
 
284
            Unit      := Enclosing_Compilation_Unit (True_Name);
 
285
            Unit_Decl := Unit_Declaration (Unit);
 
286
         else
 
287
            Unit_Decl :=
 
288
              Asis2.Declarations.Name_Declaration (Generic_Unit_Name (Outer));
 
289
            Unit      := Enclosing_Compilation_Unit (Unit_Decl);
 
290
         end if;
 
291
      exception
 
292
         when others =>
 
293
            --  Revert to the default behavior:
 
294
            Unit      := Enclosing_Compilation_Unit (True_Name);
 
295
            Unit_Decl := Unit_Declaration (Unit);
 
296
      end;
 
297
      if Use_Def then
 
298
         --  Asis sometimes returns the wrong name. Shouldn't actually happen
 
299
         --  anymore with the correction in Asis2.Naming.
 
300
         Asis2.Naming.Verify_Name_Definition (Def, Name);
 
301
         Use_Def := not Is_Nil (Def);
 
302
         if not Use_Def then
 
303
            AD.Messages.Report_Error
 
304
              (Reporter.all, "ASIS returns the wrong name here!");
 
305
         end if;
 
306
      end if;
 
307
      declare
 
308
         Result : Cross_Reference;
 
309
      begin
 
310
         Result.Ignore         :=
 
311
           Is_Equal (Decl, This_Unit) or else
 
312
           not Crossref_To_Unit (Unit);
 
313
         Result.Is_Top_Unit    := Is_Equal (Decl, Unit_Decl);
 
314
         Result.Is_Local       := Is_Equal (Unit_Decl, This_Unit);
 
315
         Result.Full_Unit_Name :=
 
316
           WASU.To_Unbounded_Wide_String (Asis2.Naming.Full_Unit_Name (Unit));
 
317
         Result.Position    :=
 
318
           Asis2.Spans.Start (Asis2.Spans.Get_Span (True_Name));
 
319
         if Use_Def then
 
320
            Result.Image :=
 
321
              WASU.To_Unbounded_Wide_String
 
322
                (Asis2.Naming.Name_Definition_Image (Def));
 
323
            --  We may use the image of 'Def' even if 'Name' is the current
 
324
            --  unit's name, for in this case, Def = Name.
 
325
         else
 
326
            Result.Image := WASU.Null_Unbounded_Wide_String;
 
327
         end if;
 
328
         return Result;
 
329
      end;
 
330
   end Crossref_Exp;
 
331
 
 
332
end AD.Crossrefs;