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