← Back to branch summary

~ubuntu-branches/ubuntu/raring/adacontrol/raring

« back to all changes in this revision

Viewing changes to src/rules-local_hiding.adb

  • Committer: Bazaar Package Importer
  • Author(s): Ludovic Brenta
  • Date: 2010-03-13 14:01:37 UTC
  • mfrom: (1.1.5 upstream) (9.1.1 sid)
  • Revision ID: james.westby@ubuntu.com-20100313140137-50ia1bbb5qld97fd
Tags: 1.12~b1-1
http://bugs.debian.org/566061
New upstream beta version.  Really closes: #566061 even on i386.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/rules-local_hiding.adb
42
42
  Thick_Queries,
43
43
  Utilities;
44
44
 
 
45
-- AdaControl
45
46
with
46
47
  Framework.Language,
47
 
  Framework.Rules_Manager,
48
 
  Framework.Reports,
49
48
  Framework.Scope_Manager;
50
49
pragma Elaborate (Framework.Language);
51
50
 
52
51
package body Rules.Local_Hiding is
53
 
   use Framework, Utilities;
 
52
   use Framework, Framework.Control_Manager, Utilities;
54
53
 
55
54
   -- Algorithm:
56
55
   -- This rule is quite easy, since most of the work is done by Scoped_Store
63
61
   -- is already the procedure itself, but the name must be attached to where the procedure is declared,
64
62
   -- i.e. the enclosing scope.
65
63
 
66
 
   type Subrules is (Strict, Overloading, Both);
67
 
   subtype True_Subrules is Subrules range Strict .. Overloading;
68
 
   package Subrules_Flag_Utilities is new Framework.Language.Flag_Utilities (Subrules);
69
 
 
70
 
   type Rule_Usage is array (True_Subrules) of Boolean;
 
64
   type Extended_Subrules is (Strict, Overloading, Overloading_Short);
 
65
   subtype Subrules is Extended_Subrules range Extended_Subrules'First .. Extended_Subrules'Pred (Overloading_Short);
 
66
   package Subrules_Flag_Utilities is new Framework.Language.Flag_Utilities (Extended_Subrules);
 
67
 
 
68
   type Modifiers is (Not_Operator, Not_Enumeration);
 
69
   package Modifiers_Flag_Utilities is new Framework.Language.Modifier_Utilities (Modifiers);
 
70
 
 
71
   type Rule_Usage is array (Subrules) of Boolean;
71
72
   Not_Used : constant Rule_Usage := (others => False);
72
73
 
73
74
   Rule_Used    : Rule_Usage := Not_Used;
74
75
   Save_Used    : Rule_Usage;
75
 
   Rule_Context : array (True_Subrules) of Basic_Rule_Context;
 
76
   Rule_Context : array (Subrules) of Basic_Rule_Context;
 
77
 
 
78
   Include_Op           : Rule_Usage;
 
79
   Include_Enum         : Rule_Usage;
 
80
   Overloading_Is_Short : Boolean;
76
81
 
77
82
   type Identifier_Data (Length : Positive) is
78
83
      record
79
 
         Name        : Wide_String (1..Length);
80
 
         Short_Last  : Positive;
81
 
         Elem        : Asis.Element;
82
 
         Is_Callable : Boolean;
 
84
         Name           : Wide_String (1..Length);
 
85
         Short_Last     : Positive;
 
86
         Elem           : Asis.Element;
 
87
         Is_Callable    : Boolean;
 
88
         Is_Enumeration : Boolean;
83
89
      end record;
84
90
   procedure Clear (Item : in out Identifier_Data) is  -- null proc
85
91
      pragma Unreferenced (Item);
93
99
   ----------
94
100
 
95
101
   procedure Help is
96
 
      use Subrules_Flag_Utilities;
 
102
      use Subrules_Flag_Utilities, Modifiers_Flag_Utilities;
97
103
   begin
98
104
      User_Message ("Rule: " & Rule_Id);
99
 
      Help_On_Flags ("Parameter(s): ", Footer => "(default = strict)");
100
 
      User_Message ("Control occurrences of local identifiers that hide an outer identical name");
 
105
      Help_On_Flags     ("Parameter(s): <exceptions> ", Footer => "(default = strict)");
 
106
      Help_On_Modifiers ("<exceptions>:");
 
107
      User_Message ("Control occurrences of local identifiers that hide or overload an identical name");
101
108
   end Help;
102
109
 
103
110
   -----------------
105
112
   -----------------
106
113
 
107
114
   procedure Add_Control (Ctl_Label : in Wide_String; Ctl_Kind : in Control_Kinds) is
108
 
      use Framework.Language, Subrules_Flag_Utilities;
109
 
      Subrule : Subrules;
 
115
      use Framework.Language, Subrules_Flag_Utilities, Modifiers_Flag_Utilities;
 
116
      Subrule         : Extended_Subrules;
 
117
      Modif_Specified : Modifier_Set;
110
118
   begin
111
119
      if Parameter_Exists then
112
120
         while Parameter_Exists loop
 
121
            Modif_Specified := Get_Modifier_Set;
113
122
            Subrule := Get_Flag_Parameter (Allow_Any => False);
114
123
            case Subrule is
115
 
               when True_Subrules =>
116
 
                  if Rule_Used (Subrule) then
117
 
                     Parameter_Error (Rule_Id, "subrule already specified");
118
 
                  end if;
119
 
                  Rule_Used    (Subrule) := True;
120
 
                  Rule_Context (Subrule) := Basic.New_Context (Ctl_Kind, Ctl_Label);
121
 
               when Both =>
122
 
                  if Rule_Used /= (True_Subrules => False) then
123
 
                     Parameter_Error (Rule_Id, "subrule already specified");
124
 
                  end if;
125
 
                  Rule_Used    := (others => True);
126
 
                  Rule_Context := (others => Basic.New_Context (Ctl_Kind, Ctl_Label));
 
124
               when Overloading =>
 
125
                  Overloading_Is_Short := False;
 
126
               when Overloading_Short =>
 
127
                  Subrule := Overloading;
 
128
                  Overloading_Is_Short := True;
 
129
               when others =>
 
130
                  null;
127
131
            end case;
 
132
            if Rule_Used (Subrule) then
 
133
               Parameter_Error (Rule_Id, "subrule already specified");
 
134
            end if;
 
135
            Rule_Used    (Subrule) := True;
 
136
            Rule_Context (Subrule) := Basic.New_Context (Ctl_Kind, Ctl_Label);
 
137
            Include_Op   (Subrule) := not Modif_Specified (Not_Operator);
 
138
            Include_Enum (Subrule) := not Modif_Specified (Not_Enumeration);
128
139
         end loop;
129
140
      else
130
141
         Rule_Used    (Strict) := True;
131
142
         Rule_Context (Strict) := Basic.New_Context (Ctl_Kind, Ctl_Label);
 
143
         Include_Op   (Strict) := True;
132
144
      end if;
133
145
   end Add_Control;
134
146
 
156
168
 
157
169
   procedure Prepare is
158
170
   begin
159
 
      if Rule_Used /= (True_Subrules => False) then
 
171
      if Rule_Used /= Not_Used then
160
172
         Visible_Identifiers.Activate;
161
173
      end if;
162
174
   end Prepare;
225
237
            return Result;
226
238
         end Enclosing_Scope;
227
239
 
228
 
         Short_Name    : constant Wide_String := To_Upper (Defining_Name_Image (Name));
229
 
         Full_Name     : constant Wide_String := Short_Name & To_Upper (Profile_Image (Name, With_Profile => False));
230
 
         Callable_Name : constant Boolean     := Is_Callable_Construct (Name);
231
 
         Is_Scope_Name : constant Boolean     := Is_Equal (Enclosing_Scope (Name), Current_Scope);
 
240
         Short_Name     : constant Wide_String := To_Upper (Defining_Name_Image (Name));
 
241
         Full_Name      : constant Wide_String := Short_Name & To_Upper (Profile_Image (Name, With_Profile => False));
 
242
         Callable_Name  : constant Boolean     := Is_Callable_Construct (Name);
 
243
         Is_Enumeration : constant Boolean     := Declaration_Kind (Enclosing_Element (Name))
 
244
                                                  = An_Enumeration_Literal_Specification;
 
245
         Is_Scope_Name  : constant Boolean     := Is_Equal (Enclosing_Scope (Name), Current_Scope);
232
246
         -- Is_Scope_Name is True if Name is the defining name for the current scope
233
247
         -- => it belongs to the enclosing scope
234
 
         Already_There : Boolean;
 
248
         Already_There  : Boolean;
 
249
         Overload_Count : Natural := 0;
 
250
         Overload_Last  : Asis.Element;
235
251
 
236
252
         type Hiding_Kinds is (Hides, Overloads, Not_Hiding);
237
253
         function Hiding_Kind (Check : Identifier_Data) return Hiding_Kinds is
275
291
               else
276
292
                  case Hiding_Kind (Visible_Identifiers.Current_Data) is
277
293
                     when Hides =>
278
 
                        if Rule_Used (Strict) then
 
294
                        if Rule_Used (Strict)
 
295
                          and (Include_Op   (Strict) or Short_Name (1) /= '"')
 
296
                          and (Include_Enum (Strict)
 
297
                               or not Is_Enumeration or not Visible_Identifiers.Current_Data.Is_Enumeration)
 
298
                        then
279
299
                           Report (Rule_Id,
280
300
                                   Rule_Context (Strict),
281
301
                                   Get_Location (Name),
284
304
                                   & Image (Get_Location (Visible_Identifiers.Current_Data.Elem)));
285
305
                        end if;
286
306
                     when Overloads =>
287
 
                        if Rule_Used (Overloading) then
288
 
                           Report (Rule_Id,
289
 
                                   Rule_Context (Overloading),
290
 
                                   Get_Location (Name),
291
 
                                   '"' & Framework.Language.Adjust_Image (To_Title (Full_Name))
292
 
                                   & """ overloads declaration at "
293
 
                                   & Image (Get_Location (Visible_Identifiers.Current_Data.Elem)));
 
307
                        if Rule_Used (Overloading)
 
308
                          and (Include_Op   (Overloading) or Short_Name (1) /= '"')
 
309
                          and (Include_Enum (Overloading)
 
310
                               or not Is_Enumeration or not Visible_Identifiers.Current_Data.Is_Enumeration)
 
311
                        then
 
312
                           if Overloading_Is_Short then
 
313
                              Overload_Count := Overload_Count + 1;
 
314
                              Overload_Last  := Visible_Identifiers.Current_Data.Elem;
 
315
                           else
 
316
                              Report (Rule_Id,
 
317
                                      Rule_Context (Overloading),
 
318
                                      Get_Location (Name),
 
319
                                      '"' & Framework.Language.Adjust_Image (To_Title (Full_Name))
 
320
                                      & """ overloads declaration at "
 
321
                                      & Image (Get_Location (Visible_Identifiers.Current_Data.Elem)));
 
322
                           end if;
294
323
                        end if;
295
324
                     when Not_Hiding =>
296
325
                        null;
298
327
               end if;
299
328
               Visible_Identifiers.Next;
300
329
            end loop;
 
330
 
 
331
            if Overload_Count /= 0 then
 
332
               -- Short form of reports of overloading, issued after the loop
 
333
               Report (Rule_Id,
 
334
                       Rule_Context (Overloading),
 
335
                       Get_Location (Name),
 
336
                       '"' & Framework.Language.Adjust_Image (To_Title (Full_Name))
 
337
                       & """ overloads "
 
338
                       & Integer_Img (Overload_Count)
 
339
                       & " declaration(s), last at "
 
340
                       & Image (Get_Location (Overload_Last)));
 
341
            end if;
301
342
         end if;
302
343
 
303
344
         if not Already_There then
307
348
               Visible_Identifiers.Push_Enclosing ((Full_Name'Length,
308
349
                                                    Full_Name,
309
350
                                                    Short_Name'Length,
310
 
                                                    Name,
311
 
                                                    Callable_Name));
 
351
                                                    First_Name,
 
352
                                                    Is_Callable    => Callable_Name,
 
353
                                                    Is_Enumeration => Is_Enumeration));
312
354
            else
313
355
               Visible_Identifiers.Push ((Full_Name'Length,
314
356
                                          Full_Name,
315
357
                                          Short_Name'Length,
316
 
                                          Name,
317
 
                                          Callable_Name));
 
358
                                          First_Name,
 
359
                                          Is_Callable    => Callable_Name,
 
360
                                          Is_Enumeration => Is_Enumeration));
318
361
            end if;
319
362
         end if;
320
363
      end;
358
401
                                                       Full_Name,
359
402
                                                       Short_Name'Length,
360
403
                                                       Name,
361
 
                                                       Is_Callable_Construct (Name)));
 
404
                                                       Is_Callable    => Is_Callable_Construct (Name),
 
405
                                                       Is_Enumeration => False));
362
406
               end;
363
407
               exit when Expression_Kind (Current) = An_Identifier;
364
408
               Current := Prefix (Current);