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          K                : Natural;
 590          L                : Natural := Line'Length;
 591          If_Pos, Then_Pos : Natural;
 592       begin
 593          if Checker.Lang.Get_Then_Layout = Checks.Rejected and then I /= 0 then
 594             if Checker.Lang.Comment /= ""
 595               and then Fixed.Index (Line, String'(Checker.Lang.Comment)) /= 0
 596             then
 597                L := Fixed.Index (Line, String'(Checker.Lang.Comment));
 598             end if;
 599
 600             If_Pos := Fixed.Index (Line (I .. L), "if");
 601
 602             K := L;
 603
 604             loop
 605                Then_Pos :=
 606                  Fixed.Index
 607                    (Line (I .. K), "then", Going => Strings.Backward);
 608                exit when Then_Pos = 0
 609                  or else Fixed.Count
 610                    (Line (Then_Pos .. K), String'(1 => '"')) mod 2 = 0;
 611                --  We exit if then is not found or if found that it is not in a
 612                --  string.
 613                K := Then_Pos;
 614             end loop;
 615
 616             if If_Pos /= 0 and then not Is_Word (If_Pos, If_Pos + 1) then
 617                --  This is not an if keyword
 618                If_Pos := 0;
 619             end if;
 620
 621             --  If no If found, check for an elsif
 622
 623             if If_Pos = 0 then
 624                If_Pos := Fixed.Index (Line (I .. L), "elsif");
 625
 626                if If_Pos /= 0 and then not Is_Word (If_Pos, If_Pos + 4) then
 627                   --  This is not an if keyword
 628                   If_Pos := 0;
 629                end if;
 630             end if;
 631
 632             if Then_Pos /= 0
 633               and then
 634                 (not Is_Word (Then_Pos, Then_Pos + 3)
 635                  or else (Then_Pos - 4 >= 1 and then Then_Pos + 3 <= L
 636                           and then
 637                             Line (Then_Pos - 4 .. Then_Pos + 3) = "and then"))
 638             then
 639                --  This is not a then keyword
 640                Then_Pos := 0;
 641             end if;
 642
 643             if Then_Pos /= 0 and then If_Pos = 0 and then Then_Pos /= I then
 644                --  then keyword not on the line with the if and it is not the
 645                --  first word on this line.
 646                Report_Error (Checker.File, "'then' incorrect layout");
 647             end if;
 648          end if;
 649       end Check_Then_Layout;
 650
 651       ---------------------------
 652       -- Check_Trailing_Spaces --
 653       ---------------------------
 654
 655       procedure Check_Trailing_Spaces is
 656       begin
 657          if Checker.Lang.Get_Trailing_Spaces = Checks.Rejected
 658            and then Line'Length > 0
 659            and then (Line (Line'Last) = ' '
 660                      or else Line (Line'Last) = ASCII.HT)
 661          then
 662             Report_Error (Checker.File, "no trailing spaces allowed");
 663          end if;
 664       end Check_Trailing_Spaces;
 665
 666       ----------------------------
 667       -- Check_With_Use_Clauses --
 668       ----------------------------
 669
 670       procedure Check_With_Use_Clauses is
 671          use Characters.Handling;
 672
 673          function Is_With_Clause return Boolean;
 674          pragma Inline (Is_With_Clause);
 675
 676          --------------------
 677          -- Is_With_Clause --
 678          --------------------
 679
 680          function Is_With_Clause return Boolean is
 681             Sep  : constant Maps.Character_Set := Maps.To_Set (" ;");
 682             F, L : Natural;
 683          begin
 684             if First_Non_Blank + 4 < Line'Last
 685               and then Line (First_Non_Blank .. First_Non_Blank + 4) = "with "
 686               and then (First_Non_Blank = Line'First
 687                           or else Line (First_Non_Blank - 1) = ' ')
 688             then
 689                --  Check now that the next word corresponds to a with clause
 690
 691                F := First_Non_Blank + 5;
 692                L := Fixed.Index (Line, Sep, From => F);
 693
 694                --  A separator is found, the first one is not ';' let's assume
 695                --  that this is not a with clause as no spaces are allowed
 696                --  for the unit name (even separating children units).
 697
 698                if L /= 0 and then Line (L) /= ';' then
 699                   return False;
 700                else
 701                   return True;
 702                end if;
 703
 704             else
 705                return False;
 706             end if;
 707          end Is_With_Clause;
 708
 709          Last : constant String := To_String (Checker.Last_With_Use_Clause);
 710          Sep  : Natural := 0;
 711       begin
 712          if Checker.Lang.Get_With_Use = Checks.Rejected then
 713             if Is_With_Clause then
 714                Sep := Fixed.Index (Line, ";");
 715
 716                --  Do not take ; into account
 717
 718                if Sep /= 0 then
 719                   Sep := Sep - 1;
 720                end if;
 721
 722                --  This is a with clause, check start of line
 723
 724                if First_Non_Blank /= Line'First then
 725                   Report_Error (Checker.File, "with bad indentation");
 726
 727                elsif Last'Length > 4
 728                  and then Last (Last'First .. Last'First + 3) = "use "
 729                then
 730                   Report_Error
 731                     (Checker.File,
 732                      "a with following a use clause, need empty line");
 733
 734                elsif Last > To_Lower (Line (First_Non_Blank .. Sep)) then
 735                   Report_Error
 736                     (Checker.File,
 737                      "with clauses must be in alphabetical order");
 738                end if;
 739
 740             elsif First_Non_Blank + 3 < Line'Last
 741               and then Line (First_Non_Blank .. First_Non_Blank + 3) = "use "
 742               and then (First_Non_Blank = Line'First
 743                         or else Line (First_Non_Blank - 1) = ' ')
 744             then
 745                Sep := Fixed.Index (Line, ";");
 746
 747                --  Do not take ; into account
 748
 749                if Sep /= 0 then
 750                   Sep := Sep - 1;
 751                end if;
 752
 753                if Last'Length > 5
 754                  and then Last (Last'First .. Last'First + 4) = "with "
 755                then
 756                   Report_Error
 757                     (Checker.File,
 758                      "a use following a with clause, need empty line");
 759
 760                elsif Last > To_Lower (Line (First_Non_Blank .. Sep)) then
 761                   Report_Error
 762                     (Checker.File,
 763                      "use clauses must be in alphabetical order");
 764                end if;
 765
 766             else
 767                --  This is not a with/use clause, clear context
 768
 769                Checker.Last_With_Use_Clause := Null_Unbounded_String;
 770             end if;
 771
 772             if Sep /= 0 then
 773                Checker.Last_With_Use_Clause :=
 774                  To_Unbounded_String
 775                    (To_Lower (Line (First_Non_Blank .. Sep)));
 776             end if;
 777          end if;
 778       end Check_With_Use_Clauses;
 779
 780    begin
 781       Check_Ending;
 782       Check_Length_Max;
 783       Check_Duplicate_Blank;
 784       Check_Trailing_Spaces;
 785       Check_Header;
 786       Check_Copyright;
 787       Check_Space_Comment;
 788       Check_Comment_Dot_EOL;
 789       Check_Tab;
 790       Check_Operator_EOL;
 791       Check_Then_Layout;
 792       Check_With_Use_Clauses;
 793    end Check_Line;
 794
 795    --------------------
 796    -- List_Languages --
 797    --------------------
 798
 799    procedure List_Languages is
 800       procedure P (Str : in String) renames Text_IO.Put_Line;
 801    begin
 802       Text_IO.New_Line;
 803       P ("Style Checker " & Version.Simple);
 804       Text_IO.New_Line;
 805       Languages.List;
 806       Text_IO.New_Line;
 807    end List_Languages;
 808
 809    ------------------
 810    -- Report_Error --
 811    ------------------
 812
 813    procedure Report_Error
 814      (File    : in File_Reader.File_Type;
 815       Message : in String;
 816       Offset  : in Line_Offset := 0)
 817    is
 818       Line : constant String :=
 819                Natural'Image (File_Reader.Line (File) + Offset);
 820    begin
 821       Error_Count := Error_Count + 1;
 822       if Error_Count <= Max_Error then
 823          if Real_Filename = Null_Unbounded_String then
 824             Text_IO.Put_Line
 825               (Text_IO.Standard_Error,
 826                File_Reader.Name (File, Absolute_Pathname) & ':'
 827                  & Line (Line'First + 1 .. Line'Last) & ": " & Message);
 828          else
 829             Text_IO.Put_Line
 830               (Text_IO.Standard_Error,
 831                To_String (Real_Filename) & ':'
 832                  & Line (Line'First + 1 .. Line'Last) & ": " & Message);
 833          end if;
 834       end if;
 835    end Report_Error;
 836
 837    procedure Report_Error
 838      (Filename : in String;
 839       Message  : in String;
 840       At_Line  : in Natural := 1)
 841    is
 842       Line : constant String := Natural'Image (At_Line);
 843    begin
 844       Error_Count := Error_Count + 1;
 845       if Error_Count <= Max_Error then
 846          if Real_Filename = Null_Unbounded_String then
 847             Text_IO.Put_Line
 848               (Text_IO.Standard_Error, Filename & ':'
 849                & Line (Line'First + 1 .. Line'Last) & ": " & Message);
 850          else
 851             Text_IO.Put_Line
 852               (Text_IO.Standard_Error,
 853                To_String (Real_Filename) & ':'
 854                & Line (Line'First + 1 .. Line'Last) & ": " & Message);
 855          end if;
 856       end if;
 857    end Report_Error;
 858
 859    -------------
 860    -- Unquote --
 861    -------------
 862
 863    function Unquote (Str : in String) return String is
 864       S : constant String := Fixed.Trim (Str, Strings.Both);
 865    begin
 866       if (S (S'First) = ''' and then S (S'Last) = ''')
 867         or else (S (S'First) = '"' and then S (S'Last) = '"')
 868       then
 869          return S (S'First + 1 .. S'Last - 1);
 870       else
 871          return S;
 872       end if;
 873    end Unquote;
 874
 875    -----------
 876    -- Usage --
 877    -----------
 878
 879    procedure Usage is
 880       procedure P (Str : in String) renames Text_IO.Put_Line;
 881    begin
 882       Text_IO.New_Line;
 883       P ("Style Checker " & Version.Simple);
 884       Text_IO.New_Line;
 885       P ("style_checker [-lang name] [options] file1 file2...");
 886       P ("   -lang       : list all built-in supported languages");
 887       P ("   -lang NAME  : following options are for this specific language");
 888       P ("   -a          : check for tabulations (default)");
 889       P ("   -A          : disable tabulations check");
 890       P ("   -abs        : output absolute path name");
 891       P ("   -ign EXT    : ignore files having EXT has extension");
 892       P ("   -b          : no duplicate blank lines (default)");
 893       P ("   -B          : disable duplicate blank lines check");
 894       P ("   -c          : check for space after comment tag (default)");
 895       P ("   -C          : disable space in comment check");
 896       P ("   -cp         : check copyright presence");
 897       P ("   -cP         : disable check for copyright presence (default)");
 898       P ("   -cy         : check for copyright year");
 899       P ("   -cY         : disable check for copyright year (default)");
 900       P ("   -cf         : if present a copyright line should match the"
 901          & " given pattern");
 902       P ("   -cF         : disable copyright pattern check");
 903       P ("   -d          : check single comment line dot ending");
 904       P ("   -D          : disable check for single comment line dot"
 905          & " ending (default)");
 906       P ("   -e DOS|UNIX : line ending style (UNIX default)");
 907       P ("   -E          : disable line ending check");
 908       P ("   -h N        : start with an header of N line (default N  20)");
 909       P ("   -H          : disable header check");
 910       P ("   -i          : enable if/then layout");
 911       P ("   -l N        : line length <= N (default 79)");
 912       P ("   -L          : disable line length check");
 913       P ("   -m N        : output only the first N errors");
 914       P ("   -n NAME     : filename to report in error message");
 915       P ("   -o          : enable operator end of line");
 916       P ("   -s          : syntax check (default)");
 917       P ("   -sp PARAM   : additional parameter for the style checker");
 918       P ("   -S          : disable syntax check");
 919       P ("   -t          : check for trailing spaces (default)");
 920       P ("   -T          : disable trailing spaces check");
 921       P ("   -v          : display version");
 922       P ("   -w          : check with/use clauses sorting/block");
 923       P ("   -W          : "
 924          & "disable check with/use clauses sorting/block (default)");
 925       Text_IO.New_Line;
 926    end Usage;
 927
 928    Lang : Languages.Lang_Access;
 929
 930 begin
 931    if Ada.Command_Line.Argument_Count = 0 then
 932       raise Checks.Syntax_Error;
 933
 934    elsif Ada.Command_Line.Argument_Count = 1
 935      and then Ada.Command_Line.Argument (1) = "-lang"
 936    then
 937       List_Languages;
 938
 939    elsif Ada.Command_Line.Argument_Count = 1
 940      and then Ada.Command_Line.Argument (1) = "-h"
 941    then
 942       Usage;
 943       Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
 944
 945    else
 946       loop
 947          case GNAT.Command_Line.Getopt
 948            ("a A abs lang: ign: e: E l? h? H i L b B s S t T v w W "
 949               & "c? C cp cy cP cY cf: cF d D sp: m: n: o")
 950          is
 951             when ASCII.NUL =>
 952                exit;
 953
 954             when 'a' =>
 955                if GNAT.Command_Line.Full_Switch = "abs" then
 956                   Absolute_Pathname := True;
 957
 958                elsif GNAT.Command_Line.Full_Switch = "a" then
 959                   Languages.Set_Tabulation (Lang, Checks.Rejected);
 960
 961                else
 962                   raise Checks.Syntax_Error;
 963                end if;
 964
 965             when 'A' =>
 966                Languages.Set_Tabulation (Lang, Checks.Accepted);
 967
 968             when 'd' =>
 969                Languages.Set_Comment_Dot_EOL (Lang, False);
 970
 971             when 'D' =>
 972                Languages.Set_Comment_Dot_EOL (Lang, True);
 973
 974             when 'e' =>
 975                Languages.Set_Line_Ending
 976                  (Lang, Checks.Line_Ending_Style'Value
 977                     (GNAT.Command_Line.Parameter));
 978
 979             when 'E' =>
 980                Languages.Set_Line_Ending (Lang, Checks.Any);
 981
 982             when 'i' =>
 983                declare
 984                   Full : constant String := GNAT.Command_Line.Full_Switch;
 985                begin
 986                   if Full = "ign" then
 987                      Ignore_Set.Include (GNAT.Command_Line.Parameter);
 988
 989                   elsif Full = "i" then
 990                      Languages.Set_Then_Layout (Lang, Checks.Rejected);
 991
 992                   else
 993                      raise Checks.Syntax_Error;
 994                   end if;
 995                end;
 996
 997             when 'l' =>
 998                declare
 999                   Full : constant String := GNAT.Command_Line.Full_Switch;
1000                begin
1001                   if Full = "lang" then
1002                      Lang := Languages.Get_From_Name
1003                        (GNAT.Command_Line.Parameter);
1004
1005                   elsif Full = "l" then
1006                      declare
1007                         P : constant String := GNAT.Command_Line.Parameter;
1008                      begin
1009                         if P = "" then
1010                            Languages.Set_Line_Length_Max (Lang, 79);
1011                         else
1012                            Languages.Set_Line_Length_Max
1013                              (Lang, Positive'Value (P));
1014                         end if;
1015                      exception
1016                         when Constraint_Error | IO_Exceptions.Name_Error =>
1017                            raise Checks.Syntax_Error;
1018                      end;
1019                   end if;
1020                end;
1021
1022             when 'L' =>
1023                Languages.Set_Line_Length_Max (Lang, Positive'Last);
1024
1025             when 'h' =>
1026                declare
1027                   P : constant String := GNAT.Command_Line.Parameter;
1028                begin
1029                   if P = "" then
1030                      Languages.Set_Header_Size (Lang, 20);
1031                   else
1032                      Languages.Set_Header_Size (Lang, Positive'Value (P));
1033                   end if;
1034                exception
1035                   when Constraint_Error | IO_Exceptions.Name_Error =>
1036                      raise Checks.Syntax_Error;
1037                end;
1038
1039             when 'H' =>
1040                Languages.Set_Header_Size (Lang, 0);
1041
1042             when 'b' =>
1043                Languages.Set_Duplicate_Blank_Line (Lang, Checks.Rejected);
1044
1045             when 'B' =>
1046                Languages.Set_Duplicate_Blank_Line (Lang, Checks.Accepted);
1047
1048             when 'o' =>
1049                Languages.Set_Operator_EOL (Lang, Checks.Rejected);
1050
1051             when 't' =>
1052                Languages.Set_Trailing_Spaces (Lang, Checks.Rejected);
1053
1054             when 'T' =>
1055                Languages.Set_Trailing_Spaces (Lang, Checks.Accepted);
1056
1057             when 's' =>
1058                declare
1059                   Full : constant String := GNAT.Command_Line.Full_Switch;
1060                begin
1061                   if Full = "sp" then
1062                      Languages.Add_Style_Checker_Parameter
1063                        (Lang, GNAT.Command_Line.Parameter);
1064
1065                   else
1066                      Languages.Set_Syntax_Check (Lang, True);
1067                   end if;
1068                end;
1069
1070             when 'S' =>
1071                Languages.Set_Syntax_Check (Lang, False);
1072
1073             when 'c' =>
1074                declare
1075                   Full : constant String := GNAT.Command_Line.Full_Switch;
1076                begin
1077                   if Full = "c" then
1078                      declare
1079                         P : constant String := GNAT.Command_Line.Parameter;
1080                      begin
1081                         if P = "" then
1082                            Languages.Set_Space_Comment (Lang, 2);
1083                         else
1084                            Languages.Set_Space_Comment
1085                              (Lang, Positive'Value (P));
1086                         end if;
1087                      end;
1088
1089                   elsif Full = "cp" then
1090                      Languages.Set_Copyright_Present (Lang, True);
1091
1092                   elsif Full = "cP" then
1093                      Languages.Set_Copyright_Present (Lang, False);
1094
1095                   elsif Full = "cy" then
1096                      Languages.Set_Copyright_Year (Lang, True);
1097
1098                   elsif Full = "cY" then
1099                      Languages.Set_Copyright_Year (Lang, False);
1100
1101                   elsif Full = "cf" then
1102                      Languages.Set_Copyright_Pattern
1103                        (Lang, Unquote (GNAT.Command_Line.Parameter));
1104
1105                   elsif Full = "cF" then
1106                      Languages.Set_Copyright_Pattern (Lang, "");
1107                   end if;
1108                end;
1109
1110             when 'C' =>
1111                Languages.Set_Space_Comment (Lang, 0);
1112
1113             when 'm' =>
1114                Max_Error := Natural'Value (GNAT.Command_Line.Parameter);
1115
1116             when 'n' =>
1117                Real_Filename :=
1118                  To_Unbounded_String (GNAT.Command_Line.Parameter);
1119
1120             when 'v' =>
1121                Text_IO.Put_Line ("Style Checker " & Version.Complete);
1122                exit;
1123
1124             when 'w' =>
1125                Languages.Set_With_Use (Lang, Checks.Rejected);
1126
1127             when 'W' =>
1128                Languages.Set_With_Use (Lang, Checks.Accepted);
1129
1130             when others =>
1131                raise Checks.Syntax_Error;
1132          end case;
1133       end loop;
1134
1135       --  Register some known extension to ignore
1136
1137       Ignore_Set.Include ("gif");
1138       Ignore_Set.Include ("png");
1139       Ignore_Set.Include ("jpg");
1140       Ignore_Set.Include ("pdf");
1141       Ignore_Set.Include ("ps");
1142       Ignore_Set.Include ("exe");
1143       Ignore_Set.Include ("dll");
1144       Ignore_Set.Include ("so");
1145       Ignore_Set.Include ("o");
1146       Ignore_Set.Include ("obj");
1147       Ignore_Set.Include ("tar");
1148       Ignore_Set.Include ("gz");
1149       Ignore_Set.Include ("bz2");
1150       Ignore_Set.Include ("7z");
1151
1152       loop
1153          declare
1154             Filename : constant String :=
1155                          GNAT.Command_Line.Get_Argument (Do_Expansion => True);
1156          begin
1157             exit when Filename'Length = 0;
1158
1159             if Directories.Exists (Filename) then
1160                if Directories.Kind (Filename) /= Directories.Directory then
1161                   declare
1162                      Ext : constant String := Directories.Extension (Filename);
1163                   begin
1164                      if (Ext /= "" and then not Ignore_Set.Contains (Ext))
1165                        or else
1166                          (Ext = "" and then not Ignore_Set.Contains
1167                               (Directories.Simple_Name (Filename)))
1168                      then
1169                         --  Do not check directory
1170                         Check (Filename);
1171                      end if;
1172                   end;
1173                end if;
1174
1175             else
1176                Report_Error (Filename, "file not found");
1177             end if;
1178          end;
1179       end loop;
1180
1181    end if;
1182
1183    if Style_Error or else Error_Count > 0 then
1184       Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
1185    else
1186       Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Success);
1187    end if;
1188
1189 exception
1190    when Checks.Syntax_Error | GNAT.Command_Line.Invalid_Switch  =>
1191       Usage;
1192       Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
1193 end Style_Checker;