src/style_checker.adb

   1 ------------------------------------------------------------------------------
   2 --                              Style Checker                               --
   3 --                                                                          --
   4 --                  Copyright (C) 2006-2011, Pascal Obry                    --
   5 --                                                                          --
   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.                                         --
  10 --                                                                          --
  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.                                --
  15 --                                                                          --
  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.          --
  19 --                                                                          --
  20 ------------------------------------------------------------------------------
  21
  22 --
  23 --  Usage:
  24 --
  25 --  style_checker [options] [-lang name] [options]
  26 --
  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).
  30 --
  31 --  To display the usage information:
  32 --     $ style_checker
  33 --
  34 --  To check Ada files only (syntax, line length, trailing spaces):
  35 --     $ style_checker -BCELS -lang Ada -slt file.ad*
  36 --
  37 --  To list available languages:
  38 --     $ style_checker -lang
  39 --
  40
  41 with Ada.Calendar;
  42 with Ada.Characters.Handling;
  43 with Ada.Command_Line;
  44 with Ada.Containers.Indefinite_Hashed_Sets;
  45 with Ada.Directories;
  46 with Ada.IO_Exceptions;
  47 with Ada.Strings.Fixed;
  48 with Ada.Strings.Hash;
  49 with Ada.Strings.Unbounded;
  50 with Ada.Text_IO;
  51
  52 with GNAT.Command_Line;
  53 with GNAT.Regpat;
  54
  55 with Version;
  56 with Checks;
  57 with File_Reader;
  58 with Languages;
  59 with Supported_Languages;
  60
  61 procedure Style_Checker is
  62
  63    use Ada;
  64    use Ada.Strings;
  65    use Ada.Strings.Unbounded;
  66    use GNAT;
  67
  68    use type Directories.File_Kind;
  69    use type Checks.Line_Ending_Style;
  70    use type Checks.Mode;
  71
  72    package Ext_Set is new Containers.Indefinite_Hashed_Sets
  73      (String, Hash, "=", "=");
  74
  75    Y : constant String :=
  76          Calendar.Year_Number'Image (Calendar.Year (Calendar.Clock));
  77    Current_Year : constant String := Y (Y'First + 1 .. Y'Last);
  78
  79    Absolute_Pathname : Boolean := False;
  80    Style_Error       : Boolean := False;
  81    Ignore_Set        : Ext_Set.Set;
  82    Max_Error         : Natural := Natural'Last;
  83    Error_Count       : Natural := 0;
  84    Real_Filename     : Unbounded_String;
  85
  86    type File_Checker is record
  87       File                 : File_Reader.File_Type;
  88       Lang                 : Languages.Lang_Access;
  89       Count_Blank          : Natural := 0;
  90       Copyright_Found      : Boolean := False;
  91       Copyright_Year       : Boolean := False;
  92       Header_Size          : Natural := 0;
  93       In_Header            : Boolean := True;
  94       Multiline_Comment    : Boolean := False;
  95       Consecutive_Comment  : Natural := 0;
  96       Last_Comment_Dot_EOL : Boolean := False;
  97    end record;
  98
  99    procedure Check (Filename : in String);
 100    --  Check this file
 101
 102    procedure Check_Line
 103      (Checker     : in out File_Checker;
 104       Line        : in     String;
 105       Line_Ending : in     Checks.Line_Ending_Style);
 106    --  Pass all checks that are line related
 107
 108    subtype Line_Offset is Integer range -1 .. 0;
 109
 110    procedure Report_Error
 111      (File    : in File_Reader.File_Type;
 112       Message : in String;
 113       Offset  : in Line_Offset := 0);
 114    --  Report an error to standard error
 115
 116    procedure Report_Error
 117      (Filename : in String;
 118       Message  : in String;
 119       At_Line  : in Natural := 1);
 120    --  Report an error to standard error
 121
 122    procedure Usage;
 123    --  Display the usage information
 124
 125    procedure List_Languages;
 126    --  Display supported languages
 127
 128    function Unquote (Str : in String) return String;
 129    --  Removes leading/trailing spaces and quote if present
 130
 131    -----------
 132    -- Check --
 133    -----------
 134
 135    procedure Check (Filename : in String) is
 136       Checker : File_Checker;
 137       Line    : String (1 .. 2_048);
 138       K       : Natural;
 139       Nb_Line : Natural := 0;
 140       Ending  : Checks.Line_Ending_Style;
 141    begin
 142       Checker.Lang := new Languages.Lang'Class'(Languages.Get (Filename));
 143
 144       --  Run line oriented tests
 145
 146       File_Reader.Open (Checker.File, Filename);
 147
 148       while not File_Reader.End_Of_File (Checker.File) loop
 149          File_Reader.Get_Line (Checker.File, Line, K, Ending);
 150          Check_Line (Checker, Line (1 .. K), Ending);
 151       end loop;
 152
 153       Nb_Line := File_Reader.Line (Checker.File);
 154
 155       File_Reader.Close (Checker.File);
 156
 157       --  Run file oriented tests
 158
 159       if Checker.Lang.Get_Syntax_Check then
 160          if not Languages.Run_Syntax_Check (Checker.Lang.all, Filename) then
 161             Style_Error := True;
 162          end if;
 163       end if;
 164
 165       if Checker.Lang.Get_Header_Size > Checker.Header_Size then
 166          if Checker.Header_Size = 0 then
 167             Report_Error
 168               (Filename, "missing file header (must start on first line)");
 169          else
 170             Report_Error
 171               (Filename, "file header should have at least"
 172                  & Positive'Image (Checker.Lang.Get_Header_Size)
 173                  & " lines, found" & Integer'Image (Checker.Header_Size));
 174          end if;
 175       end if;
 176
 177       if Checker.Lang.Get_Copyright_Present
 178         and then not Checker.Copyright_Found
 179       then
 180          Report_Error (Filename, "missing copyright notice");
 181       end if;
 182
 183       if Checker.Copyright_Found
 184         and then Checker.Lang.Get_Copyright_Year
 185         and then not Checker.Copyright_Year
 186       then
 187          Report_Error
 188            (Filename, "missing year " & Current_Year & " in copyright");
 189       end if;
 190
 191       if Checker.Lang.Get_Duplicate_Blank_Line = Checks.Rejected
 192         and then Checker.Count_Blank >= 1
 193       then
 194          Report_Error
 195            (Filename => Filename,
 196             Message => "blank line not allowed at end of file",
 197             At_Line => Nb_Line);
 198       end if;
 199
 200    exception
 201       when IO_Exceptions.Name_Error =>
 202          Report_Error (Filename, "can't open file");
 203    end Check;
 204
 205    ----------------
 206    -- Check_Line --
 207    ----------------
 208
 209    procedure Check_Line
 210      (Checker     : in out File_Checker;
 211       Line        : in     String;
 212       Line_Ending : in     Checks.Line_Ending_Style)
 213    is
 214       procedure Check_Ending;
 215
 216       procedure Check_Length_Max;
 217
 218       procedure Check_Duplicate_Blank;
 219
 220       procedure Check_Trailing_Spaces;
 221
 222       procedure Check_Header;
 223
 224       procedure Check_Copyright;
 225
 226       procedure Check_Space_Comment;
 227
 228       procedure Check_Comment_Dot_EOL;
 229
 230       procedure Check_Tab;
 231
 232       procedure Check_Operator_EOL;
 233
 234       procedure Check_Then_Layout;
 235
 236       ---------------------------
 237       -- Check_Comment_Dot_EOL --
 238       ---------------------------
 239
 240       procedure Check_Comment_Dot_EOL is
 241          Pos : Natural;
 242       begin
 243          if not Checker.Lang.Get_Comment_Dot_EOL
 244            and then Checker.Lang.Comment /= ""
 245          then
 246             if Fixed.Index (Line, String'(Checker.Lang.Comment)) /= 0 then
 247                --  This is a comment
 248                Checker.Consecutive_Comment := Checker.Consecutive_Comment + 1;
 249
 250                Pos := Fixed.Index_Non_Blank (Line, Going => Backward);
 251
 252                if Line (Pos) = '.'
 253                  and then Pos > Line'First + 1
 254                  and then Line (Pos - 2 .. Pos - 1) /= ".."
 255                then
 256                   Checker.Last_Comment_Dot_EOL := True;
 257                else
 258                   Checker.Last_Comment_Dot_EOL := False;
 259                end if;
 260
 261             else
 262                --  No more in a comment line
 263
 264                if Checker.Consecutive_Comment = 1
 265                  and then Checker.Last_Comment_Dot_EOL
 266                then
 267                   Report_Error
 268                     (Checker.File,
 269                      "single line comment should not terminate with dot",
 270                      Offset => -1);
 271                end if;
 272
 273                Checker.Consecutive_Comment := 0;
 274                Checker.Last_Comment_Dot_EOL := False;
 275             end if;
 276          end if;
 277       end Check_Comment_Dot_EOL;
 278
 279       ---------------------
 280       -- Check_Copyright --
 281       ---------------------
 282
 283       procedure Check_Copyright is
 284          use Text_IO;
 285          C_Year   : constant Boolean := Fixed.Index (Line, Current_Year) /= 0;
 286          Co_Start : Natural := 0;
 287          Cp_Start : Natural := Fixed.Index (Line, " Copyright");
 288       begin
 289          if Checker.Lang.Comment /= "" then
 290             Co_Start := Fixed.Index (Line, String'(Checker.Lang.Comment));
 291          end if;
 292
 293          if Cp_Start /= 0
 294            and then Cp_Start + 10 <= Line'Length
 295            and then Line (Cp_Start + 10) /= ' '
 296          then
 297             --  We are not at the end of the line and no space after Copyright
 298             Cp_Start := 0;
 299          end if;
 300
 301          if (Checker.Lang.Get_Copyright_Present
 302              or else Checker.Lang.Get_Copyright_Year)
 303            and then Cp_Start /= 0
 304            and then Co_Start /= 0
 305            and then Cp_Start > Co_Start
 306          then
 307             Checker.Copyright_Found := True;
 308
 309             if Checker.Lang.Get_Copyright_Year then
 310                if Fixed.Index (Line, Current_Year) /= 0 then
 311                   Checker.Copyright_Year := True;
 312                end if;
 313             end if;
 314          end if;
 315
 316          --  Check that the copyright year follow the given regexp only if we
 317          --  have found the current copyright year. This is important as
 318          --  previous copyright on a source could be with another format.
 319
 320          if Cp_Start /= 0
 321            and then C_Year
 322            and then Checker.Lang.Get_Copyright_Pattern /= ""
 323          then
 324             declare
 325                Pattern : constant Regpat.Pattern_Matcher :=
 326                            Regpat.Compile (Checker.Lang.Get_Copyright_Pattern);
 327             begin
 328                if not Regpat.Match (Pattern, Line) then
 329                   Report_Error
 330                     (Checker.File,
 331                      "copyright line not matching expected pattern");
 332                end if;
 333             end;
 334          end if;
 335       end Check_Copyright;
 336
 337       ---------------------------
 338       -- Check_Duplicate_Blank --
 339       ---------------------------
 340
 341       procedure Check_Duplicate_Blank is
 342       begin
 343          if Checker.Lang.Get_Duplicate_Blank_Line = Checks.Rejected
 344            and then (Line'Length = 0
 345                      or else Fixed.Count (Line, " " & ASCII.HT) = Line'Length)
 346          then
 347             Checker.Count_Blank := Checker.Count_Blank + 1;
 348
 349             if Checker.Count_Blank > 1 then
 350                Report_Error (Checker.File, "duplicate blank line");
 351             end if;
 352
 353          else
 354             Checker.Count_Blank := 0;
 355          end if;
 356       end Check_Duplicate_Blank;
 357
 358       ------------------
 359       -- Check_Ending --
 360       ------------------
 361
 362       procedure Check_Ending is
 363       begin
 364          if Checker.Lang.Get_Line_Ending /= Checks.Any then
 365             if Line_Ending = Checks.No then
 366                Report_Error
 367                  (Checker.File,
 368                   "missing line terminator");
 369             elsif Checker.Lang.Get_Line_Ending /= Line_Ending then
 370                Report_Error
 371                  (Checker.File,
 372                   "wrong " & Checks.Line_Ending_Style'Image (Line_Ending) &
 373                   " line ending");
 374             end if;
 375          end if;
 376       end Check_Ending;
 377
 378       ------------------
 379       -- Check_Header --
 380       ------------------
 381
 382       procedure Check_Header is
 383          C     : constant String := Checker.Lang.Comment;
 384          CS    : constant String := Checker.Lang.Start_Multiline_Comment;
 385          CE    : constant String := Checker.Lang.End_Multiline_Comment;
 386          Is_C  : constant Boolean :=
 387                    C /= ""
 388                    and then Line'Length >= C'Length
 389                    and then Line
 390                      (Line'First .. Line'First + C'Length - 1) = C;
 391          Is_CS : constant Boolean :=
 392                    CS /= ""
 393                    and then File_Reader.Line (Checker.File) = 1
 394                    and then Line'Length >= CS'Length
 395                    and then Line
 396                      (Line'First .. Line'First + CS'Length - 1) = CS;
 397          Is_CE : constant Boolean :=
 398                    CE /= ""
 399                    and then Line'Length >= CE'Length
 400                    and then Line
 401                      (Line'Last - CE'Length + 1 .. Line'Last) = CE;
 402       begin
 403          --  Check that we are starting with a multi-line comment
 404
 405          if File_Reader.Line (Checker.File) = 1 then
 406             if Is_C or else Is_CS then
 407                Checker.Header_Size := Checker.Header_Size + 1;
 408
 409                if Is_CS then
 410                   Checker.Multiline_Comment := True;
 411                end if;
 412
 413             else
 414                Checker.In_Header := False;
 415             end if;
 416
 417          else
 418             if Checker.In_Header
 419               and then
 420                 (Is_C or else (Checker.Multiline_Comment and then not Is_CE))
 421             then
 422                Checker.Header_Size := Checker.Header_Size + 1;
 423             else
 424                if Is_CE then
 425                   Checker.Header_Size := Checker.Header_Size + 1;
 426                end if;
 427                Checker.In_Header := False;
 428             end if;
 429          end if;
 430       end Check_Header;
 431
 432       ----------------------
 433       -- Check_Length_Max --
 434       ----------------------
 435
 436       procedure Check_Length_Max is
 437       begin
 438          if Line'Length > Checker.Lang.Get_Line_Length_Max then
 439             Report_Error (Checker.File, "line too long");
 440          end if;
 441       end Check_Length_Max;
 442
 443       ------------------------
 444       -- Check_Operator_EOL --
 445       ------------------------
 446
 447       procedure Check_Operator_EOL is
 448          I : constant Natural := Fixed.Index_Non_Blank (Line);
 449          L : constant Natural := Line'Length - I;
 450
 451          function Get_Operator return String;
 452          --  Returns EOL operaror of empty line if not found
 453
 454          ------------------
 455          -- Get_Operator --
 456          ------------------
 457
 458          function Get_Operator return String is
 459          begin
 460             if L > 1
 461               and then (Line (Line'Last) = '&'
 462                         or else Line (Line'Last) = '+'
 463                         or else Line (Line'Last) = '-'
 464                         or else Line (Line'Last) = '*'
 465                         or else Line (Line'Last) = '/')
 466             then
 467                return String'(1 => Line (Line'Last));
 468
 469             elsif L > 2 and then Line (Line'Last - 2 .. Line'Last) = " or" then
 470                return  Line (Line'Last - 1 .. Line'Last);
 471
 472             elsif L > 3
 473               and then (Line (Line'Last - 3 .. Line'Last) = " not"
 474                         or else Line (Line'Last - 3 .. Line'Last) = " and"
 475                         or else Line (Line'Last - 3 .. Line'Last) = " xor"
 476                         or else Line (Line'Last - 3 .. Line'Last) = " mod")
 477             then
 478                return Line (Line'Last - 2 .. Line'Last);
 479
 480             elsif L > 7
 481               and then Line (Line'Last - 7 .. Line'Last) = " or else"
 482             then
 483                return Line (Line'Last - 6 .. Line'Last);
 484
 485             elsif L > 8
 486               and then Line (Line'Last - 8 .. Line'Last) = " and then"
 487             then
 488                return Line (Line'Last - 7 .. Line'Last);
 489
 490             else
 491                return "";
 492             end if;
 493          end Get_Operator;
 494
 495       begin
 496          if Checker.Lang.Get_Operator_EOL = Checks.Rejected
 497            and then (Checker.Lang.Comment = ""
 498                        or else
 499                        Fixed.Index (Line, String'(Checker.Lang.Comment)) = 0)
 500          then
 501             declare
 502                Op : constant String := Get_Operator;
 503             begin
 504                if Op /= "" then
 505                   Report_Error
 506                     (Checker.File, ''' & Op & "' operator at end of line");
 507                end if;
 508             end;
 509          end if;
 510       end Check_Operator_EOL;
 511
 512       -------------------------
 513       -- Check_Space_Comment --
 514       -------------------------
 515
 516       procedure Check_Space_Comment is
 517          N  : constant Natural := Checker.Lang.Get_Space_Comment;
 518          NI : constant String := Natural'Image (N);
 519          C  : constant String := Checker.Lang.Comment;
 520          I  : constant Natural := Fixed.Index_Non_Blank (Line);
 521       begin
 522          if N /= 0
 523            and then I /= 0
 524            and then I + C'Length - 1 <= Line'Last
 525            and then Line (I .. I + C'Length - 1) = C
 526            and then Line (Line'Last - C'Length + 1 .. Line'Last) /= C
 527            and then (Line (I .. I + 1) /= "#!"
 528                      or else File_Reader.Line (Checker.File) > 1)
 529          --  Do no check script headers
 530          then
 531             for K in I + C'Length .. I + C'Length + N - 1 loop
 532                if Line (K) /= ' ' then
 533                   Report_Error
 534                     (Checker.File,
 535                      NI (NI'First + 1 .. NI'Last) & " spaces after " & C);
 536                   exit;
 537                end if;
 538             end loop;
 539          end if;
 540       end Check_Space_Comment;
 541
 542       ---------------
 543       -- Check_Tab --
 544       ---------------
 545
 546       procedure Check_Tab is
 547       begin
 548          if Checker.Lang.Get_Tabulation = Checks.Rejected
 549            and then Strings.Fixed.Index (Line, String'(1 => ASCII.HT)) /= 0
 550          then
 551             Report_Error (Checker.File, "no tabulations allowed");
 552          end if;
 553       end Check_Tab;
 554
 555       -----------------------
 556       -- Check_Then_Layout --
 557       -----------------------
 558
 559       procedure Check_Then_Layout is
 560
 561          function Is_Word (First, Last : Natural) return Boolean;
 562          --  Returns True if Str is a word and not a substring
 563
 564          -------------
 565          -- Is_Word --
 566          -------------
 567
 568          function Is_Word (First, Last : Natural) return Boolean is
 569             use Ada.Characters.Handling;
 570          begin
 571             if (First > Line'First
 572                 and then Is_Alphanumeric (Line (First - 1)))
 573               or else
 574                 (Last < Line'Last and then Is_Alphanumeric (Line (Last + 1)))
 575             then
 576                return False;
 577             else
 578                return True;
 579             end if;
 580          end Is_Word;
 581
 582          I                : constant Natural := Fixed.Index_Non_Blank (Line);
 583          L                : Natural := Line'Length;
 584          If_Pos, Then_Pos : Natural;
 585       begin
 586          if Checker.Lang.Get_Then_Layout = Checks.Rejected and then I /= 0 then
 587             if Checker.Lang.Comment /= ""
 588               and then Fixed.Index (Line, String'(Checker.Lang.Comment)) /= 0
 589             then
 590                L := Fixed.Index (Line, String'(Checker.Lang.Comment));
 591             end if;
 592
 593             If_Pos := Fixed.Index (Line (I .. L), "if");
 594             Then_Pos :=
 595               Fixed.Index (Line (I .. L), "then", Going => Strings.Backward);
 596
 597             if If_Pos /= 0 and then not Is_Word (If_Pos, If_Pos + 1) then
 598                --  This is not an if keyword
 599                If_Pos := 0;
 600             end if;
 601
 602             --  If no If found, check for an elsif
 603
 604             if If_Pos = 0 then
 605                If_Pos := Fixed.Index (Line (I .. L), "elsif");
 606
 607                if If_Pos /= 0 and then not Is_Word (If_Pos, If_Pos + 4) then
 608                   --  This is not an if keyword
 609                   If_Pos := 0;
 610                end if;
 611             end if;
 612
 613             if Then_Pos /= 0
 614               and then
 615                 (not Is_Word (Then_Pos, Then_Pos + 3)
 616                  or else (Then_Pos - 4 >= 1 and then Then_Pos + 3 <= L
 617                           and then
 618                             Line (Then_Pos - 4 .. Then_Pos + 3) = "and then"))
 619             then
 620                --  This is not a then keyword
 621                Then_Pos := 0;
 622             end if;
 623
 624             if Then_Pos /= 0 and then If_Pos = 0 and then Then_Pos /= I then
 625                --  then keyword not on the line with the if and it is not the
 626                --  first word on this line.
 627                Report_Error (Checker.File, "'then' incorrect layout");
 628             end if;
 629          end if;
 630       end Check_Then_Layout;
 631
 632       ---------------------------
 633       -- Check_Trailing_Spaces --
 634       ---------------------------
 635
 636       procedure Check_Trailing_Spaces is
 637       begin
 638          if Checker.Lang.Get_Trailing_Spaces = Checks.Rejected
 639            and then Line'Length > 0
 640            and then (Line (Line'Last) = ' '
 641                      or else Line (Line'Last) = ASCII.HT)
 642          then
 643             Report_Error (Checker.File, "no trailing spaces allowed");
 644          end if;
 645       end Check_Trailing_Spaces;
 646
 647    begin
 648       Check_Ending;
 649       Check_Length_Max;
 650       Check_Duplicate_Blank;
 651       Check_Trailing_Spaces;
 652       Check_Header;
 653       Check_Copyright;
 654       Check_Space_Comment;
 655       Check_Comment_Dot_EOL;
 656       Check_Tab;
 657       Check_Operator_EOL;
 658       Check_Then_Layout;
 659    end Check_Line;
 660
 661    --------------------
 662    -- List_Languages --
 663    --------------------
 664
 665    procedure List_Languages is
 666       procedure P (Str : in String) renames Text_IO.Put_Line;
 667    begin
 668       Text_IO.New_Line;
 669       P ("Style Checker " & Version.Simple);
 670       Text_IO.New_Line;
 671       Languages.List;
 672       Text_IO.New_Line;
 673    end List_Languages;
 674
 675    ------------------
 676    -- Report_Error --
 677    ------------------
 678
 679    procedure Report_Error
 680      (File    : in File_Reader.File_Type;
 681       Message : in String;
 682       Offset  : in Line_Offset := 0)
 683    is
 684       Line : constant String :=
 685                Natural'Image (File_Reader.Line (File) + Offset);
 686    begin
 687       Error_Count := Error_Count + 1;
 688       if Error_Count <= Max_Error then
 689          if Real_Filename = Null_Unbounded_String then
 690             Text_IO.Put_Line
 691               (Text_IO.Standard_Error,
 692                File_Reader.Name (File, Absolute_Pathname) & ':'
 693                  & Line (Line'First + 1 .. Line'Last) & ": " & Message);
 694          else
 695             Text_IO.Put_Line
 696               (Text_IO.Standard_Error,
 697                To_String (Real_Filename) & ':'
 698                  & Line (Line'First + 1 .. Line'Last) & ": " & Message);
 699          end if;
 700       end if;
 701    end Report_Error;
 702
 703    procedure Report_Error
 704      (Filename : in String;
 705       Message  : in String;
 706       At_Line  : in Natural := 1)
 707    is
 708       Line : constant String := Natural'Image (At_Line);
 709    begin
 710       Error_Count := Error_Count + 1;
 711       if Error_Count <= Max_Error then
 712          if Real_Filename = Null_Unbounded_String then
 713             Text_IO.Put_Line
 714               (Text_IO.Standard_Error, Filename & ':'
 715                & Line (Line'First + 1 .. Line'Last) & ": " & Message);
 716          else
 717             Text_IO.Put_Line
 718               (Text_IO.Standard_Error,
 719                To_String (Real_Filename) & ':'
 720                & Line (Line'First + 1 .. Line'Last) & ": " & Message);
 721          end if;
 722       end if;
 723    end Report_Error;
 724
 725    -------------
 726    -- Unquote --
 727    -------------
 728
 729    function Unquote (Str : in String) return String is
 730       S : constant String := Fixed.Trim (Str, Strings.Both);
 731    begin
 732       if (S (S'First) = ''' and then S (S'Last) = ''')
 733         or else (S (S'First) = '"' and then S (S'Last) = '"')
 734       then
 735          return S (S'First + 1 .. S'Last - 1);
 736       else
 737          return S;
 738       end if;
 739    end Unquote;
 740
 741    -----------
 742    -- Usage --
 743    -----------
 744
 745    procedure Usage is
 746       procedure P (Str : in String) renames Text_IO.Put_Line;
 747    begin
 748       Text_IO.New_Line;
 749       P ("Style Checker " & Version.Simple);
 750       Text_IO.New_Line;
 751       P ("style_checker [-lang name] [options] file1 file2...");
 752       P ("   -lang       : list all built-in supported languages");
 753       P ("   -lang NAME  : following options are for this specific language");
 754       P ("   -a          : check for tabulations (default)");
 755       P ("   -A          : disable tabulations check");
 756       P ("   -abs        : output absolute path name");
 757       P ("   -ign EXT    : ignore files having EXT has extension");
 758       P ("   -b          : no duplicate blank lines (default)");
 759       P ("   -B          : disable duplicate blank lines check");
 760       P ("   -c          : check for space after comment tag (default)");
 761       P ("   -C          : disable space in comment check");
 762       P ("   -cp         : check copyright presence");
 763       P ("   -cP         : disable check for copyright presence (default)");
 764       P ("   -cy         : check for copyright year");
 765       P ("   -cY         : disable check for copyright year (default)");
 766       P ("   -cf         : if present a copyright line should match the"
 767          & " given pattern");
 768       P ("   -cF         : disable copyright pattern check");
 769       P ("   -d          : check single comment line dot ending");
 770       P ("   -D          : disable check for single comment line dot"
 771          & " ending (default)");
 772       P ("   -e DOS|UNIX : line ending style (UNIX default)");
 773       P ("   -E          : disable line ending check");
 774       P ("   -h N        : start with an header of N line (default N  20)");
 775       P ("   -H          : disable header check");
 776       P ("   -i          : enable if/then layout");
 777       P ("   -l N        : line length <= N (default 79)");
 778       P ("   -L          : disable line length check");
 779       P ("   -m N        : output only the first N errors");
 780       P ("   -n NAME     : filename to report in error message");
 781       P ("   -o          : enable operator end of line");
 782       P ("   -s          : syntax check (default)");
 783       P ("   -sp PARAM   : additional parameter for the style checker");
 784       P ("   -S          : disable syntax check");
 785       P ("   -t          : check for trailing spaces (default)");
 786       P ("   -T          : disable trailing spaces check");
 787       P ("   -v          : display version");
 788       Text_IO.New_Line;
 789    end Usage;
 790
 791    Lang : Languages.Lang_Access;
 792
 793 begin
 794    if Ada.Command_Line.Argument_Count = 0 then
 795       raise Checks.Syntax_Error;
 796
 797    elsif Ada.Command_Line.Argument_Count = 1
 798      and then Ada.Command_Line.Argument (1) = "-lang"
 799    then
 800       List_Languages;
 801
 802    elsif Ada.Command_Line.Argument_Count = 1
 803      and then Ada.Command_Line.Argument (1) = "-h"
 804    then
 805       Usage;
 806       Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
 807
 808    else
 809       loop
 810          case GNAT.Command_Line.Getopt
 811            ("a A abs lang: ign: e: E l? h? H i "
 812               & "L b B s S t T v c? C cp cy cP cY cf: cF d D sp: m: n: o")
 813          is
 814             when ASCII.NUL =>
 815                exit;
 816
 817             when 'a' =>
 818                if GNAT.Command_Line.Full_Switch = "abs" then
 819                   Absolute_Pathname := True;
 820
 821                elsif GNAT.Command_Line.Full_Switch = "a" then
 822                   Languages.Set_Tabulation (Lang, Checks.Rejected);
 823
 824                else
 825                   raise Checks.Syntax_Error;
 826                end if;
 827
 828             when 'A' =>
 829                Languages.Set_Tabulation (Lang, Checks.Accepted);
 830
 831             when 'd' =>
 832                Languages.Set_Comment_Dot_EOL (Lang, False);
 833
 834             when 'D' =>
 835                Languages.Set_Comment_Dot_EOL (Lang, True);
 836
 837             when 'e' =>
 838                Languages.Set_Line_Ending
 839                  (Lang, Checks.Line_Ending_Style'Value
 840                     (GNAT.Command_Line.Parameter));
 841
 842             when 'E' =>
 843                Languages.Set_Line_Ending (Lang, Checks.Any);
 844
 845             when 'i' =>
 846                declare
 847                   Full : constant String := GNAT.Command_Line.Full_Switch;
 848                begin
 849                   if Full = "ign" then
 850                      Ignore_Set.Include (GNAT.Command_Line.Parameter);
 851
 852                   elsif Full = "i" then
 853                      Languages.Set_Then_Layout (Lang, Checks.Rejected);
 854
 855                   else
 856                      raise Checks.Syntax_Error;
 857                   end if;
 858                end;
 859
 860             when 'l' =>
 861                declare
 862                   Full : constant String := GNAT.Command_Line.Full_Switch;
 863                begin
 864                   if Full = "lang" then
 865                      Lang := Languages.Get_From_Name
 866                        (GNAT.Command_Line.Parameter);
 867
 868                   elsif Full = "l" then
 869                      declare
 870                         P : constant String := GNAT.Command_Line.Parameter;
 871                      begin
 872                         if P = "" then
 873                            Languages.Set_Line_Length_Max (Lang, 79);
 874                         else
 875                            Languages.Set_Line_Length_Max
 876                              (Lang, Positive'Value (P));
 877                         end if;
 878                      exception
 879                         when Constraint_Error | IO_Exceptions.Name_Error =>
 880                            raise Checks.Syntax_Error;
 881                      end;
 882                   end if;
 883                end;
 884
 885             when 'L' =>
 886                Languages.Set_Line_Length_Max (Lang, Positive'Last);
 887
 888             when 'h' =>
 889                declare
 890                   P : constant String := GNAT.Command_Line.Parameter;
 891                begin
 892                   if P = "" then
 893                      Languages.Set_Header_Size (Lang, 20);
 894                   else
 895                      Languages.Set_Header_Size (Lang, Positive'Value (P));
 896                   end if;
 897                exception
 898                   when Constraint_Error | IO_Exceptions.Name_Error =>
 899                      raise Checks.Syntax_Error;
 900                end;
 901
 902             when 'H' =>
 903                Languages.Set_Header_Size (Lang, 0);
 904
 905             when 'b' =>
 906                Languages.Set_Duplicate_Blank_Line (Lang, Checks.Rejected);
 907
 908             when 'B' =>
 909                Languages.Set_Duplicate_Blank_Line (Lang, Checks.Accepted);
 910
 911             when 'o' =>
 912                Languages.Set_Operator_EOL (Lang, Checks.Rejected);
 913
 914             when 't' =>
 915                Languages.Set_Trailing_Spaces (Lang, Checks.Rejected);
 916
 917             when 'T' =>
 918                Languages.Set_Trailing_Spaces (Lang, Checks.Accepted);
 919
 920             when 's' =>
 921                declare
 922                   Full : constant String := GNAT.Command_Line.Full_Switch;
 923                begin
 924                   if Full = "sp" then
 925                      Languages.Add_Style_Checker_Parameter
 926                        (Lang, GNAT.Command_Line.Parameter);
 927
 928                   else
 929                      Languages.Set_Syntax_Check (Lang, True);
 930                   end if;
 931                end;
 932
 933             when 'S' =>
 934                Languages.Set_Syntax_Check (Lang, False);
 935
 936             when 'c' =>
 937                declare
 938                   Full : constant String := GNAT.Command_Line.Full_Switch;
 939                begin
 940                   if Full = "c" then
 941                      declare
 942                         P : constant String := GNAT.Command_Line.Parameter;
 943                      begin
 944                         if P = "" then
 945                            Languages.Set_Space_Comment (Lang, 2);
 946                         else
 947                            Languages.Set_Space_Comment
 948                              (Lang, Positive'Value (P));
 949                         end if;
 950                      end;
 951
 952                   elsif Full = "cp" then
 953                      Languages.Set_Copyright_Present (Lang, True);
 954
 955                   elsif Full = "cP" then
 956                      Languages.Set_Copyright_Present (Lang, False);
 957
 958                   elsif Full = "cy" then
 959                      Languages.Set_Copyright_Year (Lang, True);
 960
 961                   elsif Full = "cY" then
 962                      Languages.Set_Copyright_Year (Lang, False);
 963
 964                   elsif Full = "cf" then
 965                      Languages.Set_Copyright_Pattern
 966                        (Lang, Unquote (GNAT.Command_Line.Parameter));
 967
 968                   elsif Full = "cF" then
 969                      Languages.Set_Copyright_Pattern (Lang, "");
 970                   end if;
 971                end;
 972
 973             when 'C' =>
 974                Languages.Set_Space_Comment (Lang, 0);
 975
 976             when 'm' =>
 977                Max_Error := Natural'Value (GNAT.Command_Line.Parameter);
 978
 979             when 'n' =>
 980                Real_Filename :=
 981                  To_Unbounded_String (GNAT.Command_Line.Parameter);
 982
 983             when 'v' =>
 984                Text_IO.Put_Line ("Style Checker " & Version.Complete);
 985                exit;
 986
 987             when others =>
 988                raise Checks.Syntax_Error;
 989          end case;
 990       end loop;
 991
 992       --  Register some known extension to ignore
 993
 994       Ignore_Set.Include ("gif");
 995       Ignore_Set.Include ("png");
 996       Ignore_Set.Include ("jpg");
 997       Ignore_Set.Include ("pdf");
 998       Ignore_Set.Include ("ps");
 999       Ignore_Set.Include ("exe");
1000       Ignore_Set.Include ("dll");
1001       Ignore_Set.Include ("so");
1002       Ignore_Set.Include ("o");
1003       Ignore_Set.Include ("obj");
1004       Ignore_Set.Include ("tar");
1005       Ignore_Set.Include ("gz");
1006       Ignore_Set.Include ("bz2");
1007       Ignore_Set.Include ("7z");
1008
1009       loop
1010          declare
1011             Filename : constant String :=
1012                          GNAT.Command_Line.Get_Argument (Do_Expansion => True);
1013          begin
1014             exit when Filename'Length = 0;
1015
1016             if Directories.Exists (Filename) then
1017                if Directories.Kind (Filename) /= Directories.Directory then
1018                   declare
1019                      Ext : constant String := Directories.Extension (Filename);
1020                   begin
1021                      if (Ext /= "" and then not Ignore_Set.Contains (Ext))
1022                        or else
1023                          (Ext = "" and then not Ignore_Set.Contains
1024                               (Directories.Simple_Name (Filename)))
1025                      then
1026                         --  Do not check directory
1027                         Check (Filename);
1028                      end if;
1029                   end;
1030                end if;
1031
1032             else
1033                Report_Error (Filename, "file not found");
1034             end if;
1035          end;
1036       end loop;
1037
1038    end if;
1039
1040    if Style_Error or else Error_Count > 0 then
1041       Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
1042    else
1043       Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Success);
1044    end if;
1045
1046 exception
1047    when Checks.Syntax_Error | GNAT.Command_Line.Invalid_Switch  =>
1048       Usage;
1049       Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
1050 end Style_Checker;