← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/rules-unsafe_paired_calls.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-unsafe_paired_calls.adb
41
41
 
42
42
-- Adalog
43
43
with
 
44
  A4G_Bugs,
44
45
  Thick_Queries,
45
46
  Utilities;
46
47
 
47
48
-- Adactl
48
49
with
49
 
  Framework.Language,
50
 
  Framework.Rules_Manager,
51
 
  Framework.Reports,
52
50
  Framework.Scope_Manager;
53
51
 
54
52
package body Rules.Unsafe_Paired_Calls is
55
 
   use Framework;
 
53
   use Framework, Framework.Control_Manager;
56
54
 
57
55
   Rules_Used : Control_Index := 0;
58
56
   Save_Used  : Control_Index;
222
220
         -- Precondition: the matching context exists
223
221
         Called_Context : constant SP_Context := SP_Context (Call_Context (The_Call));
224
222
         Sp_Image       : constant Wide_String := Full_Name_Image (Called_Name (The_Call));
225
 
      begin
 
223
 
 
224
         function Selected_Variable_Image (Var : Asis.Expression) return Wide_String is
 
225
            use Asis.Expressions;
 
226
            Sel : Asis.Expression;
 
227
         begin
 
228
            if Expression_Kind (Var) /= A_Selected_Component then
 
229
               return Full_Name_Image (Var);
 
230
            end if;
 
231
            Sel := Selector (Var);
 
232
            if Declaration_Kind (A4G_Bugs.Corresponding_Name_Declaration (Sel)) = A_Component_Declaration then
 
233
               return Selected_Variable_Image (Prefix (Var)) & '.' & A4G_Bugs.Name_Image (Sel);
 
234
            else
 
235
               return Full_Name_Image (Var);
 
236
            end if;
 
237
         end Selected_Variable_Image;
 
238
      begin  -- Call_Image
226
239
         case Called_Context.Lock.Kind is
227
240
            when None =>
228
241
               return Sp_Image;
242
255
            when In_Out_Def =>
243
256
               return Sp_Image
244
257
                 & " with lock variable "
245
 
                 & Full_Name_Image (Actual_Expression (The_Call, Called_Context.Lock.Formal));
 
258
                 & Selected_Variable_Image (Actual_Expression (The_Call, Called_Context.Lock.Formal));
246
259
            when Entity_Spec =>
247
260
               Failure ("lock field not initialized");
248
261
         end case;
253
266
         -- We must delay analyzing the lock until we have a way of getting to the corresponding
254
267
         -- element, i.e. the first time we have a call to the procedure.
255
268
         use Framework.Language;
256
 
         use Asis.Expressions;
257
269
      begin
258
270
         if Lock_Context.Lock.Kind /= Entity_Spec then
259
271
            -- Already transformed (or None)
270
282
            -- provided type.
271
283
            for I in Profile'Range loop
272
284
               Mark := Simple_Name (Declaration_Subtype_Mark (Profile (I)));
273
 
               if Matches (Mark, Lock_Context.Lock.Entity) then
 
285
               if Matches (Lock_Context.Lock.Entity, Mark) then
274
286
                  if Lock_Context.Lock.Kind /= Entity_Spec or Names (Profile (I))'Length /= 1 then
275
287
                     Parameter_Error (Rule_Id,
276
288
                                      "more than one parameter of the provided type",
279
291
                     case Mode_Kind (Profile (I)) is
280
292
                        when An_In_Mode | A_Default_In_Mode =>
281
293
                           -- Only discrete and access types allowed
282
 
                           case Type_Kind (Type_Declaration_View (Corresponding_Name_Declaration (Mark))) is
 
294
                           case Type_Kind (Type_Declaration_View (A4G_Bugs.Corresponding_Name_Declaration (Mark))) is
283
295
                              when An_Enumeration_Type_Definition
284
296
                                | A_Signed_Integer_Type_Definition
285
297
                                | A_Modular_Type_Definition
350
362
 
351
363
            -- Here we have a good call; the message always refers to the first call
352
364
            if (SP_Context (Other_Context).Rule_Numbers and Called_Context.Rule_Numbers)
353
 
              = (Control_Index_Set'Range => False)
 
365
              = Empty_Control_Index_Set
354
366
            then
355
367
               Report (Rule_Id,
356
368
                       Called_Context,
412
424
                  return False;
413
425
               end if;
414
426
               if (SP_Context (Other_Context).Rule_Numbers and Called_Context.Rule_Numbers)
415
 
                 = (Control_Index_Set'Range => False)
 
427
                 = Empty_Control_Index_Set
416
428
               then
417
429
                  return False;
418
430
               end if;
428
440
                                  Actual_Expression (Other_Call, SP_Context(Other_Context).Lock.Formal));
429
441
            when In_Out_Def =>
430
442
               declare
431
 
                  Lock_Object : constant Asis.Expression      := Actual_Expression (Call, Called_Context.Lock.Formal);
432
 
                  Other_Lock_Object :constant Asis.Expression := Actual_Expression
 
443
                  Lock_Object       : constant Asis.Expression := Actual_Expression (Call, Called_Context.Lock.Formal);
 
444
                  Other_Lock_Object : constant Asis.Expression := Actual_Expression
433
445
                                                                   (Other_Call,
434
446
                                                                    SP_Context(Other_Context).Lock.Formal);
435
447
               begin