← Back to branch summary

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

« 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: 2008-04-27 15:25:59 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20080427152559-qrlic533a1x02flu
Tags: 1.8r8-1

* New upstream version.
* debian/adacontrol.gpr: delete; use upstream's project file instead.
* patches/build.patch: patch upstream's project file to change Object_Dir
  and Exec_Dir.
* Build-depend on asis 2007 and gnat-4.3.
* Add support for mips, mipsel and ppc64.
* Build and provide ptree.
* ptree.1: new.
* adactl.1: update; new options and rules are available.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/rules-unsafe_paired_calls.adb
54
54
package body Rules.Unsafe_Paired_Calls is
55
55
   use Framework;
56
56
 
57
 
   Rules_Used : Rule_Index := 0;
58
 
   Save_Used  : Rule_Index;
 
57
   Rules_Used : Control_Index := 0;
 
58
   Save_Used  : Control_Index;
59
59
 
60
60
   type SP_Role is (Opening, Closing);
61
61
   type SP_Lock_Parameter_Kind is (None, Entity_Spec, In_Def, In_Out_Def);
74
74
   type SP_Context is new Basic_Rule_Context with
75
75
      record
76
76
         Role         : SP_Role;
77
 
         Rule_Numbers : Rule_Index_Set;
 
77
         Rule_Numbers : Control_Index_Set;
78
78
         Lock         : Lock_Parameter;
79
79
      end record;
80
80
 
97
97
      User_Message ("Controls calls like P/V operations that are not safely paired");
98
98
   end Help;
99
99
 
100
 
   -------------
101
 
   -- Add_Use --
102
 
   -------------
 
100
   -----------------
 
101
   -- Add_Control --
 
102
   -----------------
103
103
 
104
 
   procedure Add_Use (Label     : in Wide_String;
105
 
                      Rule_Type : in Rule_Types) is
 
104
   procedure Add_Control (Ctl_Label : in Wide_String; Ctl_Kind : in Control_Kinds) is
106
105
      use Framework.Language, Utilities, Ada.Strings.Wide_Fixed;
107
106
      First_SP  : Entity_Specification;
108
107
      Second_SP : Entity_Specification;
114
113
                                    LP            : in Lock_Parameter)
115
114
      is
116
115
         Existing  : Root_Context'Class := Association (Checked_Subprograms, Specification);
117
 
         Rules_Set : Rule_Index_Set := (others => False);
 
116
         Rules_Set : Control_Index_Set := (others => False);
118
117
      begin
119
118
         if Existing = No_Matching_Context then
120
119
            Rules_Set (Rules_Used) := True;
121
120
            Associate (Checked_Subprograms,
122
121
                       Specification,
123
 
                       SP_Context'(Basic.New_Context (Rule_Type,Label) with Role, Rules_Set, LP));
 
122
                       SP_Context'(Basic.New_Context (Ctl_Kind, Ctl_Label) with Role, Rules_Set, LP));
124
123
         else
125
124
            SP_Context (Existing).Rule_Numbers (Rules_Used) := True;
126
125
            Update (Checked_Subprograms, Existing);
127
126
         end if;
128
127
      end Associate_With_Set;
129
128
   begin
130
 
      if Rules_Used = Rule_Index_Set'Last then
 
129
      if Rules_Used = Control_Index_Set'Last then
131
130
         Parameter_Error (Rule_Id,
132
131
                          "this rule can be given at most"
133
 
                          & Rule_Index'Wide_Image (Rule_Index_Set'Last)
 
132
                          & Control_Index'Wide_Image(Control_Index_Set'Last)
134
133
                          & " times");
135
134
      end if;
136
135
      Rules_Used := Rules_Used + 1;
161
160
         Associate_With_Set (First_SP,  Opening, (Kind => None));
162
161
         Associate_With_Set (Second_SP, Closing, (Kind => None));
163
162
      end if;
164
 
   end Add_Use;
 
163
   end Add_Control;
165
164
 
166
165
   -------------
167
166
   -- Command --
188
187
 
189
188
   procedure Prepare is
190
189
   begin
 
190
      if Rules_Used = 0 then
 
191
         return;
 
192
      end if;
 
193
 
191
194
      Balance (Checked_Subprograms);
 
195
      Active_Procs.Activate;
192
196
   end Prepare;
193
197
 
194
198
   ------------------
344
348
 
345
349
            -- Here we have a good call; the message always refers to the first call
346
350
            if (SP_Context (Other_Context).Rule_Numbers and Called_Context.Rule_Numbers)
347
 
              = (Rule_Index_Set'Range => False)
 
351
              = (Control_Index_Set'Range => False)
348
352
            then
349
353
               Report (Rule_Id,
350
354
                       Called_Context,
406
410
                  return False;
407
411
               end if;
408
412
               if (SP_Context (Other_Context).Rule_Numbers and Called_Context.Rule_Numbers)
409
 
                 = (Rule_Index_Set'Range => False)
 
413
                 = (Control_Index_Set'Range => False)
410
414
               then
411
415
                  return False;
412
416
               end if;
655
659
   end Process_Call;
656
660
 
657
661
begin
658
 
   Framework.Rules_Manager.Register_Semantic (Rule_Id,
659
 
                                              Help    => Help'Access,
660
 
                                              Add_Use => Add_Use'Access,
661
 
                                              Command => Command'Access,
662
 
                                              Prepare => Prepare'Access);
 
662
   Framework.Rules_Manager.Register (Rule_Id,
 
663
                                     Rules_Manager.Semantic,
 
664
                                     Help_CB        => Help'Access,
 
665
                                     Add_Control_CB => Add_Control'Access,
 
666
                                     Command_CB     => Command'Access,
 
667
                                     Prepare_CB     => Prepare'Access);
663
668
end Rules.Unsafe_Paired_Calls;