← Back to branch summary

~ubuntu-branches/ubuntu/jaunty/adacontrol/jaunty

« back to all changes in this revision

Viewing changes to src/rules-parameter_aliasing.adb

  • Committer: Bazaar Package Importer
  • Author(s): Ludovic Brenta
  • Date: 2006-10-12 19:17:22 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20061012191722-fo5bcn4k5r0iubgd
Tags: 1.5r24-1

* New upstream release.
* debian/control (Depends): add gnat-4.1.
  (Enhances): add gnat-gps.
* debian/adacontrol.gpr: build pfni.
* debian/rules: install the new gnat-gps plug-in, and pfni.
* debian/pfni.1: new.
* patches/gps-integration.patch: new.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/rules-parameter_aliasing.adb
52
52
  Framework.Language,
53
53
  Framework.Rules_Manager,
54
54
  Framework.Reports;
 
55
pragma Elaborate (Framework.Language);
55
56
 
56
57
package body Rules.Parameter_Aliasing is
57
58
   use Framework, Utilities;
58
59
 
59
60
   --  Algorithm:
60
 
   --  The heart of the algorithm is the Split procedure. It takes the expression corresponding to
61
 
   --  an [in] out parameter, and splits it into the true variable on one side, a string that represents
62
 
   --  the various selectors and/or indexings applied to the variable on the other side.
63
 
   --  Split is applied between any pair of [in] out parameters (conveniently called Left and Right)
64
 
   --  When applied to the Left parameter, any indexing in the string of selectors/indexing is replaced by
65
 
   --  '1'.
66
 
   --  When applied to the Right parameter, any indexing in the string of selectors/indexing is replaced by
67
 
   --  '2' if we are searching for "certain" aliasing, and by '1' if we are searching for "possible" or
68
 
   --  "unlikely" aliasing.
69
 
   --  There is aliasing if the variables are the same and the strings are the same, or one is identical to
70
 
   --  the beginning of the other one.
71
 
   --
72
 
   --  The technique for replacing the indexing is actually "assume the best" for "certain" (we assume that
73
 
   --  indexings are different) and "assume the worst" for "possible" and "unlikely" (we assume that indexings
74
 
   --  are the same).
75
 
   --
76
 
   --  We attempt however to diagnose simple cases of static indexing. If *all* indexings for both Left and
77
 
   --  Right are integer litterals or enumeration litterals (we know that as a result of Split), we split
78
 
   --  the variables again, but this time we replace all indexings by the value of the index. This way,
79
 
   --  the strings will differ if the indexings are statically different.
80
 
   --
81
 
   --  The situation is somewhat complicated by access types. We keep track of the rightmost dereference.
82
 
   --  For "certain" and "possible", we assume the best, i.e. that dereferences designate different objects,
83
 
   --  and therefore compare only the part before the dereference.
84
 
   --  For "unlikely", we assume the worst (that the dereferences allways designate the same object).
85
 
   --  Currently, we don't take into account the type of the dereferenced object. There is still room for
86
 
   --  improvements...
87
 
 
88
 
 
89
 
   -- Order of declaration is important:
90
 
   type Rule_Detail is (Certain, Possible, Unlikely);
 
61
   --  Simply determine the "proximity" between each pair of [in] out parameters.
 
62
   --  See Thick_Queries.Variables_Proximity for the definition of proximity.
 
63
 
 
64
   subtype Rule_Detail is Thick_Queries.Result_Confidence;
 
65
 
 
66
   package Detail_Flags_Utilities is new Framework.Language.Flag_Utilities (Rule_Detail);
 
67
   use Detail_Flags_Utilities;
 
68
 
91
69
   type Usage is array (Rule_Detail) of Boolean;
92
70
   Rule_Used  : Usage := (others => False);
93
71
   Save_Used  : Usage;
100
78
 
101
79
   procedure Help is
102
80
   begin
103
 
      User_Message ("Rule: " & Rule_Id);
104
 
      User_Message ("Parameter 1: certain | possible | unlikely (optional, default=certain)");
105
 
      User_Message ("Control subprogram or entry calls where the same variable is given");
106
 
      User_Message ("for more than one [in] out parameter.");
107
 
      User_Message ("This rule can detect non-straightforward aliasing cases, see doc for details");
 
81
      User_Message  ("Rule: " & Rule_Id);
 
82
      Help_On_Flags (Header => "Parameter 1:", Footer => "(optional, default=certain)");
 
83
      User_Message  ("Control subprogram or entry calls where the same variable is given");
 
84
      User_Message  ("for more than one [in] out parameter.");
 
85
      User_Message  ("This rule can detect non-straightforward aliasing cases, see doc for details");
108
86
   end Help;
109
87
 
110
88
   -------------
114
92
   procedure Add_Use (Label         : in Wide_String;
115
93
                      Rule_Use_Type : in Rule_Types) is
116
94
      use Ada.Strings.Wide_Unbounded;
117
 
      use Framework.Language;
 
95
      use Framework.Language, Thick_Queries;
118
96
 
119
 
      function Get_Detail_Parameter is new Get_Flag_Parameter (Flags     => Rule_Detail,
120
 
                                                               Allow_Any => False);
121
97
      Detail  : Rule_Detail := Certain;
122
98
   begin
123
99
      if Parameter_Exists then
124
 
         Detail := Get_Detail_Parameter;
 
100
         Detail := Get_Flag_Parameter (Allow_Any => False);
125
101
      end if;
126
102
 
127
103
      if Rule_Used (Detail) then
164
140
   -------------
165
141
 
166
142
   procedure Prepare is
 
143
      use Thick_Queries;
 
144
   begin
167
145
      -- If weaker checks have been specified, force them for stronger ones
168
 
   begin
169
146
      if Rule_Used (Unlikely) and not Rule_Used (Possible) then
170
147
         Rule_Used  (Possible) := True;
171
148
         Rule_Type  (Possible) := Rule_Type  (Unlikely);
193
170
 
194
171
   procedure Process_Call (Call : in Asis.Statement) is
195
172
      use Asis, Asis.Declarations, Asis.Elements, Asis.Expressions, Asis.Statements;
196
 
      use Framework.Reports, Ada.Strings.Wide_Unbounded;
197
 
 
198
 
      function Are_Aliased (Left, Right : Asis.Expression;
199
 
                            Detail      : Rule_Detail) return Boolean
200
 
      is
201
 
         -- Determines if there is aliasing (Certain, Possible or Unlikely) between Left and Right.
202
 
         -- Left and Right are the actuals to an [in] out parameter, they are therefore
203
 
         -- variables, and they can't be defaulted parameters.
204
 
         --
205
 
         -- Case 1: None of the expressions includes (explicit or implicit) dereferences
206
 
         --    There is aliasing if both are exactly the same, or one is a subcomponent of
207
 
         --    the other.
208
 
         --    - Certain if there are no indexed components
209
 
         --    - Possible otherwise
210
 
         -- Case 2: At least one of the expressions includes (explicit or implicit) dereferences
211
 
         --    The "true" full variable (not considering subcomponents) is the target of the
212
 
         --    rightmost dereference.
213
 
         --    - There is aliasing if everything appearing left of this rightmost dereference
214
 
         --      is identical in Left and Right
215
 
         --      - Certain if there are no indexed components nor function calls
216
 
         --      - Possible otherwise
217
 
         --    - Otherwise, aliasing is Unlikely.
218
 
 
219
 
         type Inx_State is (None, Static, Dynamic);
220
 
 
221
 
         L_Variable  : Asis.Definition;
222
 
         L_Selectors : Unbounded_Wide_String;
223
 
         L_Deref     : Natural;
224
 
         L_Inx_Found : Inx_State;
225
 
         R_Variable  : Asis.Definition;
226
 
         R_Selectors : Unbounded_Wide_String;
227
 
         R_Deref     : Natural;
228
 
         R_Inx_Found : Inx_State;
229
 
 
230
 
         procedure Split (Name       : in     Asis.Expression;
231
 
                          Variable   :    out Asis.Definition;
232
 
                          Selectors  :    out Unbounded_Wide_String;
233
 
                          Last_Deref :    out Natural;
234
 
                          Inx_Found  :    out Inx_State;
235
 
                          Indicator  : in     Wide_Character;
236
 
                          Static_Inx : in     Boolean)
237
 
         is
238
 
            -- Given the original Name (possibly cleaned-up from a view conversion):
239
 
            -- Returns in Variable the true variable declaration (after following
240
 
            --   possible renamings)
241
 
            --
242
 
            -- Returns in Selectors the string of all selectors. A '.' is added in the end to
243
 
            --   avoid the matching of fields where one is identical to the beginning of the other.
244
 
            --   However, if there are any indexed components, the string is truncated at the
245
 
            --   selected component. Indicator is an arbitrary character so that indexed components
246
 
            --   from Left and Right are not equal. Assuming Indicator is '1':
247
 
            --   V.X.Y    => "X.Y."
248
 
            --   V.X(3).Y => "X(1)"
249
 
            --   V        => ""
250
 
            --   If Static is True, the Name is assumed to contain only litterals for the indexing
251
 
            --   of arrays, and the actual value is used in place of the indicator.
252
 
            --
253
 
            -- Returns in Last_Deref the position of the last character of the ".all"
254
 
            -- corresponding to the right-most dereference if any, or 0.
255
 
            -- Returns True in Static_Inx if some indexing were found, but they are all integer or
256
 
            -- enumeration litterals; returns False otherwise.
257
 
            use Thick_Queries;
258
 
 
259
 
            function Build_Indicator (Expr : Asis.Expression) return Wide_String is
260
 
               -- Returns the indicator for indexed expressions and slices
261
 
               -- If the expression is an enumeration or integer litteral, we can use a
262
 
               -- (normalized) representation as indicator; this will enable us to not report
263
 
               -- aliasing between X(1) and X(2).
264
 
               -- For anything else, return the provided Indicator, prepended with a '_' to
265
 
               -- distinguish from an allowed value.
266
 
               -- This function can be made more clever in the future if we can recognize more
267
 
               -- cases of static expressions.
268
 
               Good_Expr: Asis.Expression;
269
 
            begin
270
 
               if Expression_Kind (Expr) = A_Selected_Component then
271
 
                  Good_Expr := Selector (Expr);
272
 
               else
273
 
                  Good_Expr := Expr;
274
 
               end if;
275
 
 
276
 
               if Static_Inx then
277
 
                  case Expression_Kind (Good_Expr) is
278
 
                     when An_Integer_Literal =>
279
 
                        -- We make a round-trip through Value/Image below for the case of the naughty
280
 
                        -- user who wrote something like P(Tab (10#1#), Tab (1)).
281
 
                        -- The indicators must be the same!
282
 
                        return Asis_Integer'Wide_Image (Asis_Integer'Wide_Value (Value_Image (Good_Expr)));
283
 
                     when An_Enumeration_Literal =>
284
 
                        return To_Upper (Name_Image (Good_Expr));
285
 
                     when others =>
286
 
                        Failure ("Non static index in static Build_Indicator");
287
 
                  end case;
288
 
               else
289
 
                  case Expression_Kind (Good_Expr) is
290
 
                     when An_Integer_Literal
291
 
                       | An_Enumeration_Literal =>
292
 
                        if Inx_Found /= Dynamic then
293
 
                           Inx_Found := Static;
294
 
                        end if;
295
 
                     when others =>
296
 
                        Inx_Found := Dynamic;
297
 
                  end case;
298
 
                  return (1 => Indicator);
299
 
               end if;
300
 
            end Build_Indicator;
301
 
 
302
 
            procedure Add_Selector (Sel : Wide_String) is
303
 
            begin
304
 
               Selectors := Sel & Selectors;
305
 
               if Last_Deref /= 0 then
306
 
                  Last_Deref := Last_Deref + Sel'Length;
307
 
               end if;
308
 
            end Add_Selector;
309
 
 
310
 
            E          : Asis.Element := Name;
311
 
            Temp_Sel   : Unbounded_Wide_String;
312
 
            Temp_Deref : Natural;
313
 
            Temp_Found : Inx_State;
314
 
            Variable_Enclosing : Asis.Element;
315
 
         begin   -- Split
316
 
            Last_Deref := 0;
317
 
            Inx_Found  := None;
318
 
 
319
 
            Selectors := Null_Unbounded_Wide_String;
320
 
            loop
321
 
               case Expression_Kind (E) is
322
 
                  when An_Identifier =>
323
 
                     exit;
324
 
 
325
 
                  when A_Selected_Component =>
326
 
                     case Declaration_Kind (Corresponding_Name_Declaration (Selector (E))) is
327
 
                        when A_Component_Declaration | A_Discriminant_Specification =>
328
 
                           -- It's a record field, a protected type field...
329
 
                           Add_Selector (To_Upper (Name_Image (Selector (E))) & '.');
330
 
                           E := Prefix (E);
331
 
                        when A_Variable_Declaration | An_Object_Renaming_Declaration =>
332
 
                           -- Its a Pack.Var selector
333
 
                           E := Selector (E);
334
 
                           exit;
335
 
                        when others =>
336
 
                           Failure ("Wrong selected component", E);
337
 
                     end case;
338
 
 
339
 
                  when An_Indexed_Component =>
340
 
                     Add_Selector (")");
341
 
                     declare
342
 
                        Indexers : constant Asis.Expression_List := Index_Expressions (E);
343
 
                     begin
344
 
                        Add_Selector (Build_Indicator (Indexers (Indexers'Last)));
345
 
                        for I in reverse Indexers'First .. Indexers'Last - 1 loop
346
 
                           Add_Selector (Build_Indicator (Indexers (I)) & ',');
347
 
                        end loop;
348
 
                     end;
349
 
                     Add_Selector ("(");
350
 
                     E := Prefix (E);
351
 
 
352
 
                  when A_Slice =>
353
 
                     -- Well, it could be the whole object as well...
354
 
                     -- Simply ignore the slice
355
 
                     -- (Too complicated to check for static matching)
356
 
                     E := Prefix (E);
357
 
 
358
 
                  when A_Function_Call =>
359
 
                     --  a Function_Call can appear only as the first
360
 
                     --  element, and if it returns an access value,
361
 
                     --  or a composite object used for one of its
362
 
                     --  access subcomponents.
363
 
                     Add_Selector("_CALL_" & Indicator & '.');
364
 
                     E := Prefix (E);
365
 
                     if Expression_Kind (E) = A_Selected_Component then
366
 
                        E := Selector (E);
367
 
                     end if;
368
 
                     exit;
369
 
 
370
 
                  when An_Explicit_Dereference =>
371
 
                     -- "all." will be added below, since the prefix is necessarily
372
 
                     -- of an access type
373
 
                     E := Prefix (E);
374
 
 
375
 
                  when A_Type_Conversion =>
376
 
                     E := Converted_Or_Qualified_Expression (E);
377
 
 
378
 
                  when others =>
379
 
                     Failure ("Wrong variable name", E);
380
 
               end case;
381
 
 
382
 
               -- Add a "all." if the *type* is an access type
383
 
               -- This allows explicit and implicit dereferences to match
384
 
               if Expression_Type_Kind (E) = An_Access_Type_Definition then
385
 
                  Add_Selector ("all.");
386
 
                  if Last_Deref = 0 then
387
 
                     Last_Deref := 3;  -- Points to the last character of "all"
388
 
                  end if;
389
 
               end if;
390
 
            end loop;
391
 
 
392
 
            -- Return the "true" definion of Variable, after following all renamings
393
 
            -- But the renaming can be a complicated expression like:
394
 
            -- A : T renames Rec.X.Y(3);
395
 
            Variable := Corresponding_Name_Definition (E);
396
 
            loop
397
 
               Variable_Enclosing := Enclosing_Element (Variable);
398
 
               exit when Declaration_Kind (Variable_Enclosing) not in A_Renaming_Declaration;
399
 
               Split (Name       => Renamed_Entity (Variable_Enclosing),
400
 
                      Variable   => Variable,
401
 
                      Selectors  => Temp_Sel,
402
 
                      Last_Deref => Temp_Deref,
403
 
                      Inx_Found  => Temp_Found,
404
 
                      Indicator  => Indicator,
405
 
                      Static_Inx => Static_Inx);
406
 
               Add_Selector (To_Wide_String (Temp_Sel));
407
 
               if Last_Deref = 0 then
408
 
                  Last_Deref := Temp_Deref;
409
 
               end if;
410
 
               Inx_Found := Inx_State'Max (Inx_Found, Temp_Found);
411
 
            end loop;
412
 
         end Split;
413
 
 
414
 
         R_Indicator : Wide_Character;
415
 
      begin   -- Are_Aliased
416
 
         Split (Left, L_Variable, L_Selectors, L_Deref, L_Inx_Found,
417
 
                Indicator  => '1',
418
 
                Static_Inx => False);
419
 
 
420
 
         case Detail is
421
 
            when Certain =>
422
 
               R_Indicator := '2';
423
 
            when Possible | Unlikely =>
424
 
               -- Use the same indicator as for Left
425
 
               -- => all indexings and function calls will match
426
 
               R_Indicator := '1';
427
 
         end case;
428
 
         Split (Right, R_Variable, R_Selectors, R_Deref, R_Inx_Found,
429
 
                Indicator  => R_Indicator,
430
 
                Static_Inx => False);
431
 
 
432
 
         if L_Inx_Found = Static and R_Inx_Found = Static then
433
 
            -- Both are indexed, and only with static indices
434
 
            -- => Resplit with the actual values of indices
435
 
            Split (Left,  L_Variable, L_Selectors, L_Deref, L_Inx_Found,
436
 
                   Indicator  => '1',
437
 
                   Static_Inx => True);
438
 
            Split (Right, R_Variable, R_Selectors, R_Deref, R_Inx_Found,
439
 
                   Indicator  => R_Indicator,
440
 
                   Static_Inx => True);
441
 
         end if;
442
 
 
443
 
         declare
444
 
            -- X_Head is the part of the selectors up to and including the last ".all"
445
 
            -- X_Tail is the remaining of the string
446
 
            L_Head : constant Wide_String := Slice (L_Selectors, 1, L_Deref);
447
 
            L_Tail : constant Wide_String := Slice (L_Selectors, L_Deref+1, Length (L_Selectors));
448
 
            R_Head : constant Wide_String := Slice (R_Selectors, 1, R_Deref);
449
 
            R_Tail : constant Wide_String := Slice (R_Selectors, R_Deref+1, Length (R_Selectors));
450
 
         begin
451
 
            if Is_Equal (L_Variable, R_Variable) and L_Head = R_Head then
452
 
               if L_Tail'Length  > R_Tail'Length then
453
 
                  return L_Tail (L_Tail'First .. L_Tail'First + R_Tail'Length - 1) = R_Tail;
454
 
               else
455
 
                  return R_Tail (R_Tail'First .. R_Tail'First + L_Tail'Length - 1) = L_Tail;
456
 
               end if;
457
 
            else
458
 
               case Detail is
459
 
                  when Certain | Possible =>
460
 
                     return False;
461
 
                  when Unlikely =>
462
 
                     return L_Head /= "" or R_Head /= "";
463
 
               end case;
464
 
            end if;
465
 
         end;
466
 
      end Are_Aliased;
 
173
      use Thick_Queries, Framework.Reports, Ada.Strings.Wide_Unbounded;
467
174
 
468
175
   begin
469
176
      if Rule_Used = (Rule_Detail => False) then
476
183
         return;
477
184
      end if;
478
185
 
 
186
      if Expression_Kind (Called_Simple_Name (Call)) = An_Attribute_Reference then
 
187
         -- These ('Read and 'Write) are known to not have parameters that allow aliasing
 
188
         -- Moreover, the rest of the algorithm wouldn't work since parameters of
 
189
         -- attributes SP have no "name"
 
190
         return;
 
191
      end if;
 
192
 
479
193
      declare
480
 
         use Thick_Queries;
481
194
         Actuals : constant Asis.Association_List := Call_Statement_Parameters (Call);
482
195
         To_Check_Parameters : Parameters_Table (Actuals'Range);
483
196
 
493
206
         begin
494
207
            if Element_Kind (Name) = A_Defining_Name then
495
208
               return '"' & Defining_Name_Image (Name) & " => "
496
 
                      & Trim (Element_Image (Actual_Parameter (Actuals (Position))), Both) & '"';
 
209
                 & Trim (Element_Image (Actual_Parameter (Actuals (Position))), Both) & '"';
497
210
            else
498
211
               return '"' & Name_Image (Name) & " => "
499
 
                      & Trim (Element_Image (Actual_Parameter (Actuals (Position))), Both) & '"';
 
212
                 & Trim (Element_Image (Actual_Parameter (Actuals (Position))), Both) & '"';
500
213
            end if;
501
214
         end Association_Image;
502
215
 
503
216
         Mode    : Mode_Kinds;
504
 
         TCP_Top : Asis_Natural := To_Check_Parameters'First - 1;
 
217
         TCP_Top : ASIS_Natural := To_Check_Parameters'First - 1;
505
218
 
506
219
         pragma Warnings (Off, To_Check_Parameters);
507
220
         -- GNAT warns that To_Check_Parameters may be used before it has a value,
508
 
         -- but the algorithm ensures that this does not happen
 
221
         -- but the algorithm ensures that this does not happen, because the loop on J
 
222
         -- is not executed the first time.
 
223
 
 
224
         Param_Proximity : Proximity;
509
225
      begin
510
226
         for I in Actuals'Range loop
511
227
            Mode := Mode_Kind (Enclosing_Element (Formal_Name (Call, I)));
512
228
 
513
229
            if Mode in An_Out_Mode .. An_In_Out_Mode then
514
 
               for J in To_Check_Parameters'First .. TCP_Top loop
515
 
                  for Detail in Rule_Detail loop
516
 
                     if Rule_Used (Detail) and then
517
 
                       Are_Aliased (Actual_Parameter (Actuals (To_Check_Parameters (J))),
518
 
                                    Actual_Parameter (Actuals (I)),
519
 
                                    Detail)
520
 
                     then
521
 
                        Report (Rule_Id,
522
 
                                To_Wide_String (Rule_Label (Detail)),
523
 
                                Rule_Type (Detail),
524
 
                                Get_Location (Call),
525
 
                                Choose (Detail = Certain,
526
 
                                        "Certain",
527
 
                                        Choose (Detail = Possible,
528
 
                                                "Possible",
529
 
                                                "Unlikely"))
530
 
                                  & " aliasing between parameters "
531
 
                                  & Association_Image (To_Check_Parameters (J))
532
 
                                  & " and "
533
 
                                  & Association_Image (I)
534
 
                               );
535
 
 
536
 
                        -- If we found a stronger aliasing, don't check weaker ones
537
 
                        exit;
538
 
                     end if;
539
 
                  end loop;
 
230
               for J in List_Index range To_Check_Parameters'First .. TCP_Top loop
 
231
                  Param_Proximity := Variables_Proximity (Actual_Parameter (Actuals (To_Check_Parameters (J))),
 
232
                                                          Actual_Parameter (Actuals (I)));
 
233
                  if Rule_Used (Param_Proximity.Confidence) and then Param_Proximity.Overlap /= None then
 
234
                     Report (Rule_Id,
 
235
                             To_Wide_String (Rule_Label (Param_Proximity.Confidence)),
 
236
                             Rule_Type (Param_Proximity.Confidence),
 
237
                             Get_Location (Call),
 
238
                             Choose (Param_Proximity.Confidence = Certain,
 
239
                                     "Certain",
 
240
                                     Choose (Param_Proximity.Confidence = Possible,
 
241
                                             "Possible",
 
242
                                             "Unlikely"))
 
243
                             & " aliasing between parameters "
 
244
                             & Association_Image (To_Check_Parameters (J))
 
245
                             & " and "
 
246
                             & Association_Image (I)
 
247
                            );
 
248
                  end if;
540
249
               end loop;
541
250
 
542
251
               TCP_Top := TCP_Top + 1;
547
256
   end Process_Call;
548
257
 
549
258
begin
550
 
   Framework.Rules_Manager.Register (Rule_Id,
551
 
                                     Help    => Help'Access,
552
 
                                     Add_Use => Add_Use'Access,
553
 
                                     Command => Command'Access,
554
 
                                     Prepare => Prepare'Access);
 
259
   Framework.Rules_Manager.Register_Semantic (Rule_Id,
 
260
                                              Help    => Help'Access,
 
261
                                              Add_Use => Add_Use'Access,
 
262
                                              Command => Command'Access,
 
263
                                              Prepare => Prepare'Access);
555
264
end Rules.Parameter_Aliasing;