← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/rules-header_comments.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-header_comments.adb
59
59
 
60
60
   Uninitialized : constant Integer := 0;
61
61
 
62
 
   Rule_Label : array (Rule_Types) of Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
63
 
   Comments   : array (Rule_Types) of Integer := (others => Uninitialized);
64
 
 
65
 
   type Header_Kind is (Minimum, Model);
66
 
   package Header_Flag_Utilities is new Framework.Language.Flag_Utilities (Header_Kind);
67
 
 
68
 
   Reported       : array (Rule_Types) of Boolean;
 
62
   Ctl_Labels : array (Control_Kinds) of Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
 
63
   Comments   : array (Control_Kinds) of Integer := (others => Uninitialized);
 
64
 
 
65
   type Subrules is (Minimum, Model);
 
66
   package Subrules_Flag_Utilities is new Framework.Language.Flag_Utilities (Subrules);
 
67
 
 
68
   Reported       : array (Control_Kinds) of Boolean;
69
69
   Model_File     : Ada.Wide_Text_IO.File_Type;
70
 
   Model_Rule     : Rule_Types;
 
70
   Model_Kind     : Control_Kinds;
71
71
   Model_Label    : Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
72
72
   Model_Reported : Boolean;
73
73
 
75
75
 
76
76
   -- The same pattern can be used several times, hence it needs to be global
77
77
   pragma Warnings (Off);
78
 
   -- Gnat warns that Pattern and Last may be referenced before they have a value,
79
 
   -- but this cannot happen because Repeat is initialized to False (in Enter_Unit)
 
78
   -- Gnat warns that Pattern and Pat_Last may be referenced before they have a value,
 
79
   -- but this cannot happen because Line_Repeat is initialized to No_Repeat (in Enter_Unit)
80
80
   Pattern  : Pattern_String;
81
81
   Pat_Last : Natural;
82
82
   pragma Warnings (Off);
83
 
   Repeat : Boolean;
84
 
 
85
 
   -------------
86
 
   -- Add_Use --
87
 
   -------------
88
 
 
89
 
   procedure Add_Use (Label : in Wide_String; Rule_Type : in Rule_Types) is
 
83
 
 
84
   Stop_Pattern  : Pattern_String;
 
85
   Stop_Pat_Last : Natural;
 
86
   Stop_Has_Star : Boolean;
 
87
 
 
88
   type Line_Match_States is (Repeat, Single);
 
89
   Matcher_State : Line_Match_States;
 
90
 
 
91
   -----------------
 
92
   -- Add_Control --
 
93
   -----------------
 
94
 
 
95
   procedure Add_Control (Ctl_Label : in Wide_String; Ctl_Kind : in Control_Kinds) is
90
96
      use Ada.Characters.Handling, Ada.Exceptions, Ada.Strings.Wide_Unbounded, Ada.Wide_Text_IO;
91
 
      use Framework.Language, String_Matching, Header_Flag_Utilities;
 
97
      use Framework.Language, String_Matching, Subrules_Flag_Utilities;
92
98
 
93
 
      Buff : Pattern_String;
94
 
      Last : Natural;
95
 
      Kind : Header_Kind;
 
99
      Buff    : Pattern_String;
 
100
      Last    : Natural;
 
101
      Subrule : Subrules;
96
102
   begin
97
103
      if not Parameter_Exists then
98
104
         Parameter_Error (Rule_Id, "kind of check required");
99
105
      end if;
100
 
      Kind := Get_Flag_Parameter (Allow_Any => False);
 
106
      Subrule := Get_Flag_Parameter (Allow_Any => False);
101
107
 
102
 
      case Kind is
 
108
      case Subrule is
103
109
         when Minimum =>
104
 
            if Comments (Rule_Type) /= Uninitialized then
 
110
            if Comments (Ctl_Kind) /= Uninitialized then
105
111
               Parameter_Error (Rule_Id, "rule already specified");
106
112
            elsif not Parameter_Exists then
107
113
               Parameter_Error (Rule_Id, "number of comment lines required");
108
114
            end if;
109
 
            Comments   (Rule_Type) := Get_Integer_Parameter (Min => 1);
110
 
            Rule_Label (Rule_Type) := To_Unbounded_Wide_String (Label);
 
115
            Comments   (Ctl_Kind) := Get_Integer_Parameter (Min => 1);
 
116
            Ctl_Labels (Ctl_Kind) := To_Unbounded_Wide_String (Ctl_Label);
111
117
 
112
118
         when Model =>
113
119
            if Is_Open (Model_File) then
143
149
                     end;
144
150
                  end if;
145
151
 
146
 
                  if Last = Buff'Last then     --## rule line off If_For_Case ## Case wouldn't be pretty here...
 
152
                  if Last = Buff'Last then     --## rule line off Simplifiable_Statements ## If_For_Case
147
153
                     Parameter_Error (Rule_Id, "pattern too long at "
148
154
                                        & To_Wide_String (Name (Model_File)) & ':'
149
155
                                        & Ada.Wide_Text_IO.Count'Wide_Image (Line (Model_File)));
157
163
                  end if;
158
164
               exception
159
165
                  when Occur : Pattern_Error =>
160
 
                     Parameter_Error (Rule_Id, "incorrect pattern at "
161
 
                                        & To_Wide_String (Name (Model_File)) & ':'
162
 
                                        & Ada.Wide_Text_IO.Count'Wide_Image (Line (Model_File))
163
 
                                        & ": " & Buff (1 .. Last)
164
 
                                        & " (" & To_Wide_String (Exception_Message (Occur)) & ')');
 
166
                     Parameter_Error (Rule_Id, "incorrect pattern "
 
167
                                      & " (" & To_Wide_String (Exception_Message (Occur)) & ") at "
 
168
                                      & To_Wide_String (Name (Model_File)) & ':'
 
169
                                      & Ada.Wide_Text_IO.Count'Wide_Image (Line (Model_File))
 
170
                                      & ": " & Buff (1 .. Last));
165
171
                  when End_Error =>
166
172
                     exit;
167
173
               end;
168
174
            end loop;
169
 
            Model_Rule  := Rule_Type;
170
 
            Model_Label := To_Unbounded_Wide_String (Label);
 
175
            Model_Kind  := Ctl_Kind;
 
176
            Model_Label := To_Unbounded_Wide_String (Ctl_Label);
171
177
      end case;
172
178
 
173
179
      Rule_Used := True;
174
 
   end Add_Use;
 
180
   end Add_Control;
175
181
 
176
182
   ----------
177
183
   -- Help --
178
184
   ----------
179
185
 
180
186
   procedure Help is
181
 
      use Utilities, Header_Flag_Utilities;
 
187
      use Utilities, Subrules_Flag_Utilities;
182
188
   begin
183
189
      User_Message ("Rule: " & Rule_Id);
184
190
      Help_On_Flags ("Parameter (1):");
220
226
   procedure Enter_Unit is
221
227
      use Ada.Wide_Text_IO;
222
228
   begin
223
 
      for R in Rule_Types loop
 
229
      for R in Control_Kinds loop
224
230
         Reported (R) := Comments (R) = Uninitialized;
225
231
      end loop;
226
232
      Model_Reported := False;
227
233
      if Is_Open (Model_File) then
228
234
         Reset (Model_File, In_File);
229
 
         Repeat := False;
 
235
         Matcher_State := Single;
230
236
      end if;
231
237
   end Enter_Unit;
232
238
 
239
245
      use Ada.Strings.Wide_Unbounded;
240
246
      Line_Num : Natural;
241
247
 
242
 
      procedure Check_Comments_Number (Rule_Type : Rule_Types) is
 
248
      procedure Check_Comments_Number (Ctl_Kind : Control_Kinds) is
243
249
      begin
244
 
         if Comments (Rule_Type) < 1 or Reported (Rule_Type) then
 
250
         if Comments (Ctl_Kind) < 1 or Reported (Ctl_Kind) then
245
251
            return;
246
252
         end if;
247
253
 
248
 
         if Line_Num > Comments (Rule_Type) then
249
 
            Reported (Rule_Type) := True;
 
254
         if Line_Num > Comments (Ctl_Kind) then
 
255
            Reported (Ctl_Kind) := True;
250
256
            return;
251
257
         end if;
252
258
 
260
266
         end loop;
261
267
 
262
268
         -- Here we have a non-comment line in the range where a check is required
263
 
         Report (Rule_Id, To_Wide_String (Rule_Label (Rule_Type)), Rule_Type, Loc,
 
269
         Report (Rule_Id, To_Wide_String (Ctl_Labels (Ctl_Kind)), Ctl_Kind, Loc,
264
270
                 "not enough header comment lines");
265
 
         Reported (Rule_Type) := True;
266
 
         if Rule_Type = Check and Comments (Search) >= 1 then
 
271
         Reported (Ctl_Kind) := True;
 
272
         if Ctl_Kind = Check and Comments (Search) >= 1 then
267
273
            Reported (Search) := True;
268
274
         end if;
269
275
      end Check_Comments_Number;
270
276
 
271
277
      procedure Check_Model is
272
 
         use String_Matching;
273
278
         use Ada.Wide_Text_IO;
 
279
 
 
280
         function Line_Match (With_Pattern : Wide_String; Last : Natural) return Boolean is
 
281
            use String_Matching;
 
282
            -- True matching that considers that the empty line matches only the empty pattern
 
283
         begin
 
284
            if Line'Length = 0 or Last = 0 then
 
285
               return Last = Line'Length;
 
286
            else
 
287
               return Match (Line, With_Pattern (1 .. Last));
 
288
            end if;
 
289
         end Line_Match;
 
290
 
274
291
      begin
275
292
         if not Is_Open (Model_File) or Model_Reported then
276
293
            return;
277
294
         end if;
278
295
 
279
 
         if not Repeat then
280
 
            Get_Line (Model_File, Pattern, Pat_Last);
281
 
            if Pattern (1 .. Pat_Last) = "*" then
282
 
               Repeat := True;
283
 
               Get_Line (Model_File, Pattern, Pat_Last);
284
 
            end if;
285
 
         end if;
286
 
 
287
 
         if (Pat_Last = 0 and Line'Length /= 0)
288
 
           or else not Match (Line, Pattern (1..Pat_Last))
289
 
         then
290
 
            if Repeat then
291
 
               -- maybe the end of the repeated pattern
292
 
               Repeat := False;
293
 
               -- give it another chance
294
 
               Check_Model;
295
 
            else
296
 
               Report (Rule_Id, To_Wide_String (Model_Label), Model_Rule, Loc,
297
 
                       "line does not match pattern");
298
 
               Model_Reported := True;
299
 
            end if;
300
 
         end if;
301
 
      exception
302
 
         when End_Error =>
303
 
            Model_Reported := True;
 
296
         case Matcher_State is
 
297
            when Single =>
 
298
               begin
 
299
                  Get_Line (Model_File, Pattern, Pat_Last);
 
300
               exception
 
301
                  when End_Error =>
 
302
                     Model_Reported := True;
 
303
                     return;
 
304
               end;
 
305
 
 
306
               if Pattern (1 .. Pat_Last) = "*" then
 
307
                  -- Remember that a "*" line is always followed by a regular line
 
308
                  -- (checked in Add_Control)
 
309
                  Get_Line (Model_File, Pattern, Pat_Last);
 
310
 
 
311
                  begin
 
312
                     Get_Line (Model_File, Stop_Pattern, Stop_Pat_Last);
 
313
                     Matcher_State := Repeat;
 
314
                     Stop_Has_Star := Stop_Pattern (1 .. Stop_Pat_Last) = "*" ;
 
315
                     if Stop_Has_Star then
 
316
                        Get_Line (Model_File, Stop_Pattern, Stop_Pat_Last);
 
317
                     end if;
 
318
                  exception
 
319
                     when End_Error =>
 
320
                        -- Nothing after "*" pattern: no need to check further
 
321
                        Model_Reported := True;
 
322
                        return;
 
323
                  end;
 
324
 
 
325
                  -- Retry in Repeat state
 
326
                  Check_Model;
 
327
 
 
328
               elsif Line_Match (Pattern, Pat_Last) then
 
329
                  null;
 
330
 
 
331
               else
 
332
                  Report (Rule_Id, To_Wide_String (Model_Label), Model_Kind, Loc,
 
333
                          "line does not match pattern """ & Pattern (1 .. Pat_Last) & '"');
 
334
                  Model_Reported := True;
 
335
               end if;
 
336
 
 
337
            when Repeat =>
 
338
               -- Check the stopping pattern first, to avoid "greedy" effects
 
339
               if Line_Match (Stop_Pattern, Stop_Pat_Last) then
 
340
                  Pattern  := Stop_Pattern;
 
341
                  Pat_Last := Stop_Pat_Last;
 
342
                  if Stop_Has_Star then
 
343
                     -- Stay in Repeat state
 
344
                     begin
 
345
                        Get_Line (Model_File, Stop_Pattern, Stop_Pat_Last);
 
346
                        Stop_Has_Star := Stop_Pattern (1 .. Stop_Pat_Last) = "*" ;
 
347
                        if Stop_Has_Star then
 
348
                           Get_Line (Model_File, Stop_Pattern, Stop_Pat_Last);
 
349
                        end if;
 
350
                     exception
 
351
                        when End_Error =>
 
352
                           -- Nothing after "*" pattern: no need to check further
 
353
                           Model_Reported := True;
 
354
                     end;
 
355
                  else
 
356
                     Matcher_State := Single;
 
357
                  end if;
 
358
 
 
359
               elsif Line_Match (Pattern, Pat_Last) then
 
360
                  null;
 
361
 
 
362
               else
 
363
                  Report (Rule_Id, To_Wide_String (Model_Label), Model_Kind, Loc,
 
364
                          "line does not match pattern """ & Stop_Pattern (1 .. Stop_Pat_Last) & '"');
 
365
                  Model_Reported := True;
 
366
               end if;
 
367
         end case;
304
368
      end Check_Model;
305
369
 
306
370
   begin
307
 
      if not Rule_Used or Reported = (Rule_Types => True) then
 
371
      if not Rule_Used
 
372
        or (Reported = (Control_Kinds => True) and Model_Reported)
 
373
      then
308
374
         return;
309
375
      end if;
310
376
      Rules_Manager.Enter (Rule_Id);
311
377
 
312
378
      Line_Num := Get_First_Line (Loc);
313
379
 
314
 
      for R in Rule_Types loop
 
380
      for R in Control_Kinds loop
315
381
         Check_Comments_Number (R);
316
382
      end loop;
317
383
 
319
385
  end Process_Line;
320
386
 
321
387
begin
322
 
   Framework.Rules_Manager.Register_Textual (Rule_Id,
323
 
                                             Help    => Help'Access,
324
 
                                             Add_Use => Add_Use'Access,
325
 
                                             Command => Command'Access);
 
388
   Framework.Rules_Manager.Register (Rule_Id,
 
389
                                     Rules_Manager.Textual,
 
390
                                     Help_CB        => Help'Access,
 
391
                                     Add_Control_CB => Add_Control'Access,
 
392
                                     Command_CB     => Command'Access);
326
393
end Rules.Header_Comments;