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