1 ------------------------------------------------------------------------------
4 -- Copyright (C) 2006-2008, Pascal Obry --
6 -- This library is free software; you can redistribute it and/or modify --
7 -- it under the terms of the GNU General Public License as published by --
8 -- the Free Software Foundation; either version 2 of the License, or (at --
9 -- your option) any later version. --
11 -- This library is distributed in the hope that it will be useful, but --
12 -- WITHOUT ANY WARRANTY; without even the implied warranty of --
13 -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
14 -- General Public License for more details. --
16 -- You should have received a copy of the GNU General Public License --
17 -- along with this library; if not, write to the Free Software Foundation, --
18 -- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
20 ------------------------------------------------------------------------------
25 -- style_checker [options] [-lang name] [options]
27 -- The first options are set for all available languages.
28 -- Options that are set after a -lang name are only set for this specific
29 -- language (language names are not case sensitive).
31 -- To display the usage information:
34 -- To check Ada files only (syntax, line length, trailing spaces):
35 -- $ style_checker -BCELS -lang Ada -slt file.ad*
37 -- To list available languages:
38 -- $ style_checker -lang
42 with Ada
.Command_Line
;
43 with Ada
.Containers
.Indefinite_Hashed_Sets
;
45 with Ada
.IO_Exceptions
;
46 with Ada
.Strings
.Fixed
;
47 with Ada
.Strings
.Hash
;
48 with Ada
.Strings
.Unbounded
;
51 with GNAT
.Command_Line
;
58 with Supported_Languages
;
60 procedure Style_Checker
is
64 use Ada
.Strings
.Unbounded
;
67 use type Directories
.File_Kind
;
68 use type Checks
.Line_Ending_Style
;
71 package Ext_Set
is new Containers
.Indefinite_Hashed_Sets
72 (String, Hash
, "=", "=");
74 Y
: constant String :=
75 Calendar
.Year_Number
'Image (Calendar
.Year
(Calendar
.Clock
));
76 Current_Year
: constant String := Y
(Y
'First + 1 .. Y
'Last);
78 Absolute_Pathname
: Boolean := False;
79 Style_Error
: Boolean := False;
80 Ignore_Set
: Ext_Set
.Set
;
81 Max_Error
: Natural := Natural'Last;
82 Error_Count
: Natural := 0;
83 Real_Filename
: Unbounded_String
;
85 type File_Checker
is record
86 File
: File_Reader
.File_Type
;
87 Lang
: Languages
.Lang_Access
;
88 Count_Blank
: Natural := 0;
89 Copyright_Found
: Boolean := False;
90 Copyright_Year
: Boolean := False;
91 Header_Size
: Natural := 0;
92 In_Header
: Boolean := True;
93 Consecutive_Comment
: Natural := 0;
94 Last_Comment_Dot_EOL
: Boolean := False;
97 procedure Check
(Filename
: in String);
101 (Checker
: in out File_Checker
;
103 Line_Ending
: in Checks
.Line_Ending_Style
);
104 -- Pass all checks that are line related
106 subtype Line_Offset
is Integer range -1 .. 0;
108 procedure Report_Error
109 (File
: in File_Reader
.File_Type
;
111 Offset
: in Line_Offset
:= 0);
112 -- Report an error to standard error
114 procedure Report_Error
115 (Filename
: in String;
117 At_Line
: in Natural := 1);
118 -- Report an error to standard error
121 -- Display the usage information
123 procedure List_Languages
;
124 -- Display supported languages
126 function Unquote
(Str
: in String) return String;
127 -- Removes leading/trailing spaces and quote if present
133 procedure Check
(Filename
: in String) is
134 Checker
: File_Checker
;
135 Line
: String (1 .. 2_048
);
137 Nb_Line
: Natural := 0;
138 Ending
: Checks
.Line_Ending_Style
;
140 Checker
.Lang
:= new Languages
.Lang
'Class'(Languages.Get (Filename));
142 -- Run line oriented tests
144 File_Reader.Open (Checker.File, Filename);
146 while not File_Reader.End_Of_File (Checker.File) loop
147 File_Reader.Get_Line (Checker.File, Line, K, Ending);
148 Check_Line (Checker, Line (1 .. K), Ending);
151 Nb_Line := File_Reader.Line (Checker.File);
153 File_Reader.Close (Checker.File);
155 -- Run file oriented tests
157 if Checker.Lang.Get_Syntax_Check then
158 if not Languages.Run_Syntax_Check (Checker.Lang.all, Filename) then
163 if Checker.Lang.Get_Header_Size > Checker.Header_Size then
164 if Checker.Header_Size = 0 then
166 (Filename, "missing file header (must start on first line)");
169 (Filename, "file header should have at least"
170 & Positive'Image (Checker.Lang.Get_Header_Size)
175 if Checker.Lang.Get_Copyright_Present
176 and then not Checker.Copyright_Found
178 Report_Error (Filename, "missing copyright notice");
181 if Checker.Copyright_Found
182 and then Checker.Lang.Get_Copyright_Year
183 and then not Checker.Copyright_Year
186 (Filename, "missing year " & Current_Year & " in copyright");
189 if Checker.Lang.Get_Duplicate_Blank_Line = Checks.Rejected
190 and then Checker.Count_Blank >= 1
193 (Filename => Filename,
194 Message => "blank line not allowed at end of file",
199 when IO_Exceptions.Name_Error =>
200 Report_Error (Filename, "can't open file");
208 (Checker : in out File_Checker;
210 Line_Ending : in Checks.Line_Ending_Style)
212 procedure Check_Ending;
214 procedure Check_Length_Max;
216 procedure Check_Duplicate_Blank;
218 procedure Check_Trailing_Spaces;
220 procedure Check_Header;
222 procedure Check_Copyright;
224 procedure Check_Space_Comment;
226 procedure Check_Comment_Dot_EOL;
228 ---------------------------
229 -- Check_Comment_Dot_EOL --
230 ---------------------------
232 procedure Check_Comment_Dot_EOL is
235 if not Checker.Lang.Get_Comment_Dot_EOL
236 and then Checker.Lang.Comment /= ""
238 if Fixed.Index (Line, String'(Checker
.Lang
.Comment
)) /= 0 then
240 Checker
.Consecutive_Comment
:= Checker
.Consecutive_Comment
+ 1;
242 Pos
:= Fixed
.Index_Non_Blank
(Line
, Going
=> Backward
);
245 and then Pos
> Line
'First + 1
246 and then Line
(Pos
- 2 .. Pos
- 1) /= ".."
248 Checker
.Last_Comment_Dot_EOL
:= True;
250 Checker
.Last_Comment_Dot_EOL
:= False;
254 -- No more in a comment line
256 if Checker
.Consecutive_Comment
= 1
257 and then Checker
.Last_Comment_Dot_EOL
261 "single line comment should not terminate with dot",
265 Checker
.Consecutive_Comment
:= 0;
266 Checker
.Last_Comment_Dot_EOL
:= False;
269 end Check_Comment_Dot_EOL
;
271 ---------------------
272 -- Check_Copyright --
273 ---------------------
275 procedure Check_Copyright
is
277 Co_Start
: Natural := 0;
278 Cp_Start
: Natural := Fixed
.Index
(Line
, " Copyright");
280 if Checker
.Lang
.Comment
/= "" then
281 Co_Start
:= Fixed
.Index
(Line
, String'(Checker.Lang.Comment));
285 and then Cp_Start + 10 <= Line'Length
286 and then Line (Cp_Start + 10) /= ' '
288 -- We are not at the end of the line and no space after Copyright
292 if (Checker.Lang.Get_Copyright_Present
293 or else Checker.Lang.Get_Copyright_Year)
294 and then Cp_Start /= 0
295 and then Co_Start /= 0
296 and then Cp_Start > Co_Start
298 Checker.Copyright_Found := True;
300 if Checker.Lang.Get_Copyright_Year then
301 if Fixed.Index (Line, Current_Year) /= 0 then
302 Checker.Copyright_Year := True;
307 -- Check that the copyright year follow the given regexp
310 and then Checker.Lang.Get_Copyright_Pattern /= ""
313 Pattern : constant Regpat.Pattern_Matcher :=
314 Regpat.Compile (Checker.Lang.Get_Copyright_Pattern);
316 if not Regpat.Match (Pattern, Line) then
319 "copyright line not matching expected pattern");
325 ---------------------------
326 -- Check_Duplicate_Blank --
327 ---------------------------
329 procedure Check_Duplicate_Blank is
331 if Checker.Lang.Get_Duplicate_Blank_Line = Checks.Rejected
332 and then (Line'Length = 0
333 or else Fixed.Count (Line, " " & ASCII.HT) = Line'Length)
335 Checker.Count_Blank := Checker.Count_Blank + 1;
337 if Checker.Count_Blank > 1 then
338 Report_Error (Checker.File, "duplicate blank line");
342 Checker.Count_Blank := 0;
344 end Check_Duplicate_Blank;
350 procedure Check_Ending is
352 if Checker.Lang.Get_Line_Ending /= Checks.Any then
353 if Line_Ending = Checks.No then
356 "missing line terminator");
357 elsif Checker.Lang.Get_Line_Ending /= Line_Ending then
360 "wrong " & Checks.Line_Ending_Style'Image (Line_Ending) &
370 procedure Check_Header is
371 C : constant String := Checker.Lang.Comment;
374 and then Line'Length >= C'Length
375 and then Line (Line'First .. Line'First + C'Length - 1) = C
377 Checker.Header_Size := Checker.Header_Size + 1;
379 Checker.In_Header := False;
383 ----------------------
384 -- Check_Length_Max --
385 ----------------------
387 procedure Check_Length_Max is
389 if Line'Length > Checker.Lang.Get_Line_Length_Max then
390 Report_Error (Checker.File, "line too long");
392 end Check_Length_Max;
394 -------------------------
395 -- Check_Space_Comment --
396 -------------------------
398 procedure Check_Space_Comment is
399 N : constant Natural := Checker.Lang.Get_Space_Comment;
400 NI : constant String := Natural'Image (N);
401 C : constant String := Checker.Lang.Comment;
402 I : constant Natural := Fixed.Index_Non_Blank (Line);
406 and then I + C'Length - 1 <= Line'Last
407 and then Line (I .. I + C'Length - 1) = C
408 and then Line (Line'Last - C'Length + 1 .. Line'Last) /= C
409 and then (Line (I .. I + 1) /= "#!"
410 or else File_Reader.Line (Checker.File) > 1)
411 -- Do no check script headers
413 for K in I + C'Length .. I + C'Length + N - 1 loop
414 if Line (K) /= ' ' then
417 NI (NI'First + 1 .. NI'Last) & " spaces after " & C);
422 end Check_Space_Comment;
424 ---------------------------
425 -- Check_Trailing_Spaces --
426 ---------------------------
428 procedure Check_Trailing_Spaces is
430 if Checker.Lang.Get_Trailing_Spaces = Checks.Rejected
431 and then Line'Length > 0
432 and then (Line (Line'Last) = ' '
433 or else Line (Line'Last) = ASCII.HT)
435 Report_Error (Checker.File, "no trailing spaces allowed");
437 end Check_Trailing_Spaces;
442 Check_Duplicate_Blank;
443 Check_Trailing_Spaces;
447 Check_Comment_Dot_EOL;
454 procedure List_Languages is
455 procedure P (Str : in String) renames Text_IO.Put_Line;
458 P ("Style Checker " & Version.Simple);
468 procedure Report_Error
469 (File : in File_Reader.File_Type;
471 Offset : in Line_Offset := 0)
473 Line : constant String :=
474 Natural'Image (File_Reader.Line (File) + Offset);
476 Error_Count := Error_Count + 1;
477 if Error_Count <= Max_Error then
478 if Real_Filename = Null_Unbounded_String then
480 (Text_IO.Standard_Error,
481 File_Reader.Name (File, Absolute_Pathname) & ':'
482 & Line (Line'First + 1 .. Line'Last) & ": " & Message);
485 (Text_IO.Standard_Error,
486 To_String (Real_Filename) & ':'
487 & Line (Line'First + 1 .. Line'Last) & ": " & Message);
492 procedure Report_Error
493 (Filename : in String;
495 At_Line : in Natural := 1)
497 Line : constant String := Natural'Image (At_Line);
499 Error_Count := Error_Count + 1;
500 if Error_Count <= Max_Error then
501 if Real_Filename = Null_Unbounded_String then
503 (Text_IO.Standard_Error, Filename & ':'
504 & Line (Line'First + 1 .. Line'Last) & ": " & Message);
507 (Text_IO.Standard_Error,
508 To_String (Real_Filename) & ':'
509 & Line (Line'First + 1 .. Line'Last) & ": " & Message);
518 function Unquote (Str : in String) return String is
519 S : String := Fixed.Trim (Str, Strings.Both);
521 if (S (S'First) = ''' and then S (S'Last) = ''')
522 or else (S (S'First) = '"' and then S (S'Last) = '"')
524 return S (S'First + 1 .. S'Last - 1);
535 procedure P (Str : in String) renames Text_IO.Put_Line;
538 P ("Style Checker " & Version.Simple);
540 P ("style_checker [-lang name] [options] file1 file2...");
541 P (" -lang : list all built-in supported languages");
542 P (" -lang NAME : following options are for this specific language");
543 P (" -abs : output absolute path name");
544 P (" -ign EXT : ignore files having EXT has extension");
545 P (" -b : no duplicate blank lines (default)");
546 P (" -B : disable duplicate blank lines check");
547 P (" -c : check for space after comment tag (default)");
548 P (" -C : disable space in comment check");
549 P (" -cp : check copyright presence");
550 P (" -cP : disable check for copyright presence (default)");
551 P (" -cy : check for copyright year");
552 P (" -cY : disbale check for copyright year (default)");
553 P (" -cf : if present a copyright line should match the"
555 P (" -cF : disable copyright pattern check");
556 P (" -d : check single comment line dot ending");
557 P (" -D : disable check for single comment line dot ending");
558 P (" -e DOS|UNIX : line ending style (UNIX default)");
559 P (" -E : disable line ending check");
560 P (" -h N : start with an header of N line (default N 20)");
561 P (" -H : disable header check");
562 P (" -l N : line length <= N (default 79)");
563 P (" -L : disable line length check");
564 P (" -m N : output only the first N errors");
565 P (" -n NAME : filename to report in error message");
566 P (" -s : syntax check (default)");
567 P (" -sp PARAM : additional parameter for the style checker");
568 P (" -S : disable syntax check");
569 P (" -t : check for trailing spaces (default)");
570 P (" -T : disable trailing spaces check");
571 P (" -v : display version");
575 Lang : Languages.Lang_Access;
578 if Ada.Command_Line.Argument_Count = 0 then
579 raise Checks.Syntax_Error;
581 elsif Ada.Command_Line.Argument_Count = 1
582 and then Ada.Command_Line.Argument (1) = "-lang"
588 case GNAT.Command_Line.Getopt
589 ("abs lang: ign: e: E l? h? H "
590 & "L b B s S t T v c? C cp cy cP cY cf: cF d D sp: m: n:")
596 if GNAT.Command_Line.Full_Switch = "abs" then
597 Absolute_Pathname := True;
599 raise Checks.Syntax_Error;
603 Languages.Set_Comment_Dot_EOL (Lang, False);
606 Languages.Set_Comment_Dot_EOL (Lang, True);
609 Languages.Set_Line_Ending
610 (Lang, Checks.Line_Ending_Style'Value
611 (GNAT.Command_Line.Parameter));
614 Languages.Set_Line_Ending (Lang, Checks.Any);
618 Full : constant String := GNAT.Command_Line.Full_Switch;
621 Ignore_Set.Include (GNAT.Command_Line.Parameter);
623 raise Checks.Syntax_Error;
629 Full : constant String := GNAT.Command_Line.Full_Switch;
631 if Full = "lang" then
632 Lang := Languages.Get_From_Name
633 (GNAT.Command_Line.Parameter);
635 elsif Full = "l" then
637 P : constant String := GNAT.Command_Line.Parameter;
640 Languages.Set_Line_Length_Max (Lang, 79);
642 Languages.Set_Line_Length_Max
643 (Lang, Positive'Value (P));
646 when Constraint_Error | IO_Exceptions.Name_Error =>
647 raise Checks.Syntax_Error;
653 Languages.Set_Line_Length_Max (Lang, Positive'Last);
657 P : constant String := GNAT.Command_Line.Parameter;
660 Languages.Set_Header_Size (Lang, 20);
662 Languages.Set_Header_Size (Lang, Positive'Value (P));
665 when Constraint_Error | IO_Exceptions.Name_Error =>
666 raise Checks.Syntax_Error;
670 Languages.Set_Header_Size (Lang, 0);
673 Languages.Set_Duplicate_Blank_Line (Lang, Checks.Rejected);
676 Languages.Set_Duplicate_Blank_Line (Lang, Checks.Accepted);
679 Languages.Set_Trailing_Spaces (Lang, Checks.Rejected);
682 Languages.Set_Trailing_Spaces (Lang, Checks.Accepted);
686 Full : constant String := GNAT.Command_Line.Full_Switch;
689 Languages.Add_Style_Checker_Parameter
690 (Lang, GNAT.Command_Line.Parameter);
693 Languages.Set_Syntax_Check (Lang, True);
698 Languages.Set_Syntax_Check (Lang, False);
702 Full : constant String := GNAT.Command_Line.Full_Switch;
706 P : constant String := GNAT.Command_Line.Parameter;
709 Languages.Set_Space_Comment (Lang, 2);
711 Languages.Set_Space_Comment
712 (Lang, Positive'Value (P));
716 elsif Full = "cp" then
717 Languages.Set_Copyright_Present (Lang, True);
719 elsif Full = "cP" then
720 Languages.Set_Copyright_Present (Lang, False);
722 elsif Full = "cy" then
723 Languages.Set_Copyright_Year (Lang, True);
725 elsif Full = "cY" then
726 Languages.Set_Copyright_Year (Lang, False);
728 elsif Full = "cf" then
729 Languages.Set_Copyright_Pattern
730 (Lang, Unquote (GNAT.Command_Line.Parameter));
732 elsif Full = "cF" then
733 Languages.Set_Copyright_Pattern (Lang, "");
738 Languages.Set_Space_Comment (Lang, 0);
741 Max_Error := Natural'Value (GNAT.Command_Line.Parameter);
745 To_Unbounded_String (GNAT.Command_Line.Parameter);
748 Text_IO.Put_Line ("Style Checker " & Version.Complete);
752 raise Checks.Syntax_Error;
756 -- Register some known extension to ignore
758 Ignore_Set.Include ("gif");
759 Ignore_Set.Include ("png");
760 Ignore_Set.Include ("jpg");
761 Ignore_Set.Include ("pdf");
762 Ignore_Set.Include ("ps");
763 Ignore_Set.Include ("exe");
764 Ignore_Set.Include ("dll");
765 Ignore_Set.Include ("so");
766 Ignore_Set.Include ("o");
767 Ignore_Set.Include ("obj");
768 Ignore_Set.Include ("tar");
769 Ignore_Set.Include ("gz");
770 Ignore_Set.Include ("bz2");
771 Ignore_Set.Include ("7z");
775 Filename : constant String :=
776 GNAT.Command_Line.Get_Argument (Do_Expansion => True);
778 exit when Filename'Length = 0;
780 if Directories.Exists (Filename) then
781 if Directories.Kind (Filename) /= Directories.Directory then
783 Ext : constant String := Directories.Extension (Filename);
785 if (Ext /= "" and then not Ignore_Set.Contains (Ext))
787 (Ext = "" and then not Ignore_Set.Contains
788 (Directories.Simple_Name (Filename)))
790 -- Do not check directory
797 Report_Error (Filename, "file not found");
804 if Style_Error or else Error_Count > 0 then
805 Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
807 Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Success);
811 when Checks.Syntax_Error | GNAT.Command_Line.Invalid_Switch =>
813 Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);