← 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: 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-parameter_aliasing.adb
43
43
 
44
44
-- Adalog
45
45
with
 
46
  A4G_Bugs,
46
47
  Thick_Queries,
47
48
  Utilities;
48
49
 
68
69
   type Usage is array (Rule_Detail) of Boolean;
69
70
   Rule_Used  : Usage := (others => False);
70
71
   Save_Used  : Usage;
71
 
   Rule_Type  : array (Rule_Detail) of Rule_Types;
72
 
   Rule_Label : array (Rule_Detail) of Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
 
72
   Ctl_Kinds  : array (Rule_Detail) of Control_Kinds;
 
73
   Ctl_Labels : array (Rule_Detail) of Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
 
74
   With_In    : array (Rule_Detail) of Boolean;
73
75
 
74
76
   ----------
75
77
   -- Help --
78
80
   procedure Help is
79
81
   begin
80
82
      User_Message  ("Rule: " & Rule_Id);
81
 
      Help_On_Flags (Header => "Parameter 1:", Footer => "(optional, default=certain)");
 
83
      Help_On_Flags (Header => "Parameter 1: [with_in] ",
 
84
                     Footer => "(optional, default=certain)");
82
85
      User_Message  ("Control subprogram or entry calls where the same variable is given");
83
86
      User_Message  ("for more than one [in] out parameter.");
84
 
      User_Message  ("This rule can detect non-straightforward aliasing cases, see doc for details");
 
87
      User_Message  ("If ""with_in"" is given, consider also in parameters");
85
88
   end Help;
86
89
 
87
 
   -------------
88
 
   -- Add_Use --
89
 
   -------------
 
90
   -----------------
 
91
   -- Add_Control --
 
92
   -----------------
90
93
 
91
 
   procedure Add_Use (Label         : in Wide_String;
92
 
                      Rule_Use_Type : in Rule_Types) is
 
94
   procedure Add_Control (Ctl_Label : in Wide_String; Ctl_Kind : in Control_Kinds) is
93
95
      use Ada.Strings.Wide_Unbounded;
94
96
      use Framework.Language, Thick_Queries;
95
97
 
96
 
      Detail  : Rule_Detail := Certain;
 
98
      Detail  : Rule_Detail;
 
99
      In_Flag : Boolean;
97
100
   begin
98
101
      if Parameter_Exists then
99
 
         Detail := Get_Flag_Parameter (Allow_Any => False);
 
102
         In_Flag := Get_Modifier ("WITH_IN");
 
103
         Detail  := Get_Flag_Parameter (Allow_Any => False);
 
104
      else
 
105
         In_Flag := False;
 
106
         Detail  := Certain;
100
107
      end if;
101
108
 
102
109
      if Rule_Used (Detail) then
110
117
         Parameter_Error (Rule_Id, "only one parameter allowed");
111
118
      end if;
112
119
 
113
 
      Rule_Type  (Detail) := Rule_Use_Type;
114
 
      Rule_Label (Detail) := To_Unbounded_Wide_String (Label);
 
120
      Ctl_Kinds  (Detail) := Ctl_Kind;
 
121
      Ctl_Labels (Detail) := To_Unbounded_Wide_String (Ctl_Label);
115
122
      Rule_Used  (Detail) := True;
116
 
   end Add_Use;
 
123
      With_In    (Detail) := In_Flag;
 
124
   end Add_Control;
117
125
 
118
126
 
119
127
   -------------
126
134
      case Action is
127
135
         when Clear =>
128
136
            Rule_Used  := (others => False);
129
 
            Rule_Label := (others => Null_Unbounded_Wide_String);
 
137
            Ctl_Labels := (others => Null_Unbounded_Wide_String);
130
138
         when Suspend =>
131
139
            Save_Used := Rule_Used;
132
140
            Rule_Used := (others => False);
145
153
      -- If weaker checks have been specified, force them for stronger ones
146
154
      if Rule_Used (Unlikely) and not Rule_Used (Possible) then
147
155
         Rule_Used  (Possible) := True;
148
 
         Rule_Type  (Possible) := Rule_Type  (Unlikely);
149
 
         Rule_Label (Possible) := Rule_Label (Unlikely);
 
156
         Ctl_Kinds  (Possible) := Ctl_Kinds  (Unlikely);
 
157
         Ctl_Labels (Possible) := Ctl_Labels (Unlikely);
 
158
         With_In    (Possible) := With_In    (Unlikely);
150
159
      end if;
151
160
      if Rule_Used (Possible) and not Rule_Used (Certain) then
152
161
         Rule_Used  (Certain) := True;
153
 
         Rule_Type  (Certain) := Rule_Type  (Possible);
154
 
         Rule_Label (Certain) := Rule_Label (Possible);
 
162
         Ctl_Kinds  (Certain) := Ctl_Kinds  (Possible);
 
163
         Ctl_Labels (Certain) := Ctl_Labels (Possible);
 
164
         With_In    (Certain) := With_In    (Possible);
155
165
      end if;
156
166
   end Prepare;
157
167
 
160
170
   -- Process_Call --
161
171
   ------------------
162
172
 
163
 
   type Parameters_Table is array (Asis.List_Index range <>) of Asis.List_Index;
 
173
   type Parameters_Descr is
 
174
      record
 
175
         Mode : Asis.Mode_Kinds;
 
176
         Expr : Asis.Expression;
 
177
      end record;
164
178
 
165
 
   -- NB:
166
 
   -- Some of the algorithms in this procedure are a bit convoluted, because we avoid
167
 
   -- using normalized formals and actuals list, which are UNIMPLEMENTED in some versions
168
 
   -- of ASIS-for-Gnat.
169
 
   -- Some rewriting might be in order when the problem goes away...
 
179
   type Parameters_Table is array (Asis.List_Index range <>) of Parameters_Descr;
170
180
 
171
181
   procedure Process_Call (Call : in Asis.Statement) is
172
 
      use Asis, Asis.Declarations, Asis.Elements, Asis.Expressions, Asis.Statements;
 
182
      use Asis, Asis.Elements, Asis.Expressions, Asis.Statements;
173
183
      use Thick_Queries, Framework.Reports, Ada.Strings.Wide_Unbounded;
174
184
 
175
185
   begin
195
205
            -- plain identifier.
196
206
            -- This kludge is needed because currently the function Formal_Name is
197
207
            -- inconsistent, depending on whether the actual association is positionnal or named
198
 
            use Asis.Text;
 
208
            use Asis.Declarations, Asis.Text;
199
209
 
200
210
            Name : constant Asis.Name := Formal_Name (Call, Position);
201
211
         begin
203
213
               return '"' & Defining_Name_Image (Name) & " => "
204
214
                 & Trim_All (Element_Image (Actual_Parameter (Actuals (Position)))) & '"';
205
215
            else
206
 
               return '"' & Name_Image (Name) & " => "
 
216
               return '"' & A4G_Bugs.Name_Image (Name) & " => "
207
217
                 & Trim_All (Element_Image (Actual_Parameter (Actuals (Position)))) & '"';
208
218
            end if;
209
219
         end Association_Image;
210
220
 
211
 
         Mode    : Mode_Kinds;
212
 
         TCP_Top : ASIS_Natural := To_Check_Parameters'First - 1;
213
 
 
214
 
         pragma Warnings (Off, To_Check_Parameters);
215
 
         -- GNAT warns that To_Check_Parameters may be used before it has a value,
216
 
         -- but the algorithm ensures that this does not happen, because the loop on J
217
 
         -- is not executed the first time.
218
 
 
219
221
         Param_Proximity : Proximity;
220
222
      begin
221
 
         if Actuals'Length = 1 then
222
 
            -- Only 1 parameter => no possible aliasing
 
223
         if Actuals'Length <= 1 then
 
224
            -- 0 or 1 parameter => no possible aliasing
223
225
            return;
224
226
         end if;
225
227
 
229
231
         end if;
230
232
 
231
233
         for I in Actuals'Range loop
232
 
            Mode := Mode_Kind (Enclosing_Element (Formal_Name (Call, I)));
233
 
 
234
 
            if Mode in An_Out_Mode .. An_In_Out_Mode then
235
 
               for J in List_Index range To_Check_Parameters'First .. TCP_Top loop
236
 
                  Param_Proximity := Variables_Proximity (Actual_Parameter (Actuals (To_Check_Parameters (J))),
237
 
                                                          Actual_Parameter (Actuals (I)));
238
 
                  if Rule_Used (Param_Proximity.Confidence) and then Param_Proximity.Overlap /= None then
239
 
                     Report (Rule_Id,
240
 
                             To_Wide_String (Rule_Label (Param_Proximity.Confidence)),
241
 
                             Rule_Type (Param_Proximity.Confidence),
242
 
                             Get_Location (Call),
243
 
                             Choose (Param_Proximity.Confidence = Certain,
244
 
                                     "Certain",
245
 
                                     Choose (Param_Proximity.Confidence = Possible,
246
 
                                             "Possible",
247
 
                                             "Unlikely"))
248
 
                             & " aliasing between parameters "
249
 
                             & Association_Image (To_Check_Parameters (J))
250
 
                             & " and "
251
 
                             & Association_Image (I)
252
 
                            );
253
 
                  end if;
254
 
               end loop;
255
 
 
256
 
               TCP_Top := TCP_Top + 1;
257
 
               To_Check_Parameters (TCP_Top) := I;
258
 
            end if;
 
234
            To_Check_Parameters (I) := (Mode_Kind (Enclosing_Element (Formal_Name (Call, I))),
 
235
                                        Actual_Parameter (Actuals (I)));
 
236
            for J in List_Index range To_Check_Parameters'First .. I-1 loop
 
237
               Param_Proximity := Variables_Proximity (To_Check_Parameters (J).Expr,
 
238
                                                       To_Check_Parameters (I).Expr);
 
239
               if Rule_Used (Param_Proximity.Confidence)
 
240
                 and then Param_Proximity.Overlap /= None
 
241
                 and then (((To_Check_Parameters (I).Mode in An_Out_Mode .. An_In_Out_Mode
 
242
                            or else With_In (Param_Proximity.Confidence))
 
243
                        and To_Check_Parameters (J).Mode in An_Out_Mode .. An_In_Out_Mode)
 
244
                     or    ((To_Check_Parameters (J).Mode in An_Out_Mode .. An_In_Out_Mode
 
245
                            or else With_In (Param_Proximity.Confidence))
 
246
                        and To_Check_Parameters (I).Mode in An_Out_Mode .. An_In_Out_Mode))
 
247
               then
 
248
                  Report (Rule_Id,
 
249
                    To_Wide_String (Ctl_Labels (Param_Proximity.Confidence)),
 
250
                    Ctl_Kinds (Param_Proximity.Confidence),
 
251
                    Get_Location (Call),
 
252
                    Choose (Param_Proximity.Confidence = Certain,
 
253
                      "Certain",
 
254
                      Choose (Param_Proximity.Confidence = Possible,
 
255
                        "Possible",
 
256
                        "Unlikely"))
 
257
                    & " aliasing between parameters "
 
258
                    & Association_Image (J)
 
259
                    & " and "
 
260
                    & Association_Image (I)
 
261
                   );
 
262
               end if;
 
263
            end loop;
259
264
         end loop;
260
265
      end;
261
266
   end Process_Call;
262
267
 
263
268
begin
264
 
   Framework.Rules_Manager.Register_Semantic (Rule_Id,
265
 
                                              Help    => Help'Access,
266
 
                                              Add_Use => Add_Use'Access,
267
 
                                              Command => Command'Access,
268
 
                                              Prepare => Prepare'Access);
 
269
   Framework.Rules_Manager.Register (Rule_Id,
 
270
                                     Rules_Manager.Semantic,
 
271
                                     Help_CB        => Help'Access,
 
272
                                     Add_Control_CB => Add_Control'Access,
 
273
                                     Command_CB     => Command'Access,
 
274
                                     Prepare_CB     => Prepare'Access);
269
275
end Rules.Parameter_Aliasing;