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