gcc/ada/stylesw.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              S T Y L E S W                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Hostparm; use Hostparm;
  27 with Opt;      use Opt;
  28 with Output;   use Output;
  29
  30 package body Stylesw is
  31
  32    --  The following constant defines the default style options for -gnaty
  33
  34    Default_Style : constant String :=
  35                      "3" &  -- indentation level is 3
  36                      "a" &  -- check attribute casing
  37                      "A" &  -- check array attribute indexes
  38                      "b" &  -- check no blanks at end of lines
  39                      "c" &  -- check comment formats
  40                      "e" &  -- check end/exit labels present
  41                      "f" &  -- check no form/feeds vertical tabs in source
  42                      "h" &  -- check no horizontal tabs in source
  43                      "i" &  -- check if-then layout
  44                      "k" &  -- check casing rules for keywords
  45                      "l" &  -- check reference manual layout
  46                      "m" &  -- check line length <= 79 characters
  47                      "n" &  -- check casing of package Standard idents
  48                      "p" &  -- check pragma casing
  49                      "r" &  -- check casing for identifier references
  50                      "s" &  -- check separate subprogram specs present
  51                      "t";   -- check token separation rules
  52
  53    --  The following constant defines the GNAT style options, showing them
  54    --  as additions to the standard default style check options.
  55
  56    GNAT_Style    : constant String := Default_Style &
  57                      "d" &  -- check no DOS line terminators
  58                      "I" &  -- check mode IN
  59                      "S" &  -- check separate lines after THEN or ELSE
  60                      "u" &  -- check no unnecessary blank lines
  61                      "x";   -- check extra parentheses around conditionals
  62
  63    --  Note: we intend GNAT_Style to also include the following, but we do
  64    --  not yet have the whole tool suite clean with respect to this.
  65
  66    --                "B" &  -- check boolean operators
  67
  68    -------------------------------
  69    -- Reset_Style_Check_Options --
  70    -------------------------------
  71
  72    procedure Reset_Style_Check_Options is
  73    begin
  74       Style_Check_Indentation           := 0;
  75       Style_Check_Array_Attribute_Index := False;
  76       Style_Check_Attribute_Casing      := False;
  77       Style_Check_Blanks_At_End         := False;
  78       Style_Check_Blank_Lines           := False;
  79       Style_Check_Boolean_And_Or        := False;
  80       Style_Check_Comments              := False;
  81       Style_Check_DOS_Line_Terminator   := False;
  82       Style_Check_End_Labels            := False;
  83       Style_Check_Form_Feeds            := False;
  84       Style_Check_Horizontal_Tabs       := False;
  85       Style_Check_If_Then_Layout        := False;
  86       Style_Check_Keyword_Casing        := False;
  87       Style_Check_Layout                := False;
  88       Style_Check_Max_Line_Length       := False;
  89       Style_Check_Max_Nesting_Level     := False;
  90       Style_Check_Missing_Overriding    := False;
  91       Style_Check_Mode_In               := False;
  92       Style_Check_Order_Subprograms     := False;
  93       Style_Check_Pragma_Casing         := False;
  94       Style_Check_References            := False;
  95       Style_Check_Separate_Stmt_Lines   := False;
  96       Style_Check_Specs                 := False;
  97       Style_Check_Standard              := False;
  98       Style_Check_Tokens                := False;
  99       Style_Check_Xtra_Parens           := False;
 100    end Reset_Style_Check_Options;
 101
 102    ---------------------
 103    -- RM_Column_Check --
 104    ---------------------
 105
 106    function RM_Column_Check return Boolean is
 107    begin
 108       return Style_Check and Style_Check_Layout;
 109    end RM_Column_Check;
 110
 111    ------------------------------
 112    -- Save_Style_Check_Options --
 113    ------------------------------
 114
 115    procedure Save_Style_Check_Options (Options : out Style_Check_Options) is
 116       P : Natural := 0;
 117
 118       procedure Add (C : Character; S : Boolean);
 119       --  Add given character C to string if switch S is true
 120
 121       procedure Add_Nat (N : Nat);
 122       --  Add given natural number to string
 123
 124       ---------
 125       -- Add --
 126       ---------
 127
 128       procedure Add (C : Character; S : Boolean) is
 129       begin
 130          if S then
 131             P := P + 1;
 132             Options (P) := C;
 133          end if;
 134       end Add;
 135
 136       -------------
 137       -- Add_Nat --
 138       -------------
 139
 140       procedure Add_Nat (N : Nat) is
 141       begin
 142          if N > 9 then
 143             Add_Nat (N / 10);
 144          end if;
 145
 146          P := P + 1;
 147          Options (P) := Character'Val (Character'Pos ('0') + N mod 10);
 148       end Add_Nat;
 149
 150    --  Start of processing for Save_Style_Check_Options
 151
 152    begin
 153       for K in Options'Range loop
 154          Options (K) := ' ';
 155       end loop;
 156
 157       Add (Character'Val (Style_Check_Indentation + Character'Pos ('0')),
 158            Style_Check_Indentation /= 0);
 159
 160       Add ('a', Style_Check_Attribute_Casing);
 161       Add ('A', Style_Check_Array_Attribute_Index);
 162       Add ('b', Style_Check_Blanks_At_End);
 163       Add ('B', Style_Check_Boolean_And_Or);
 164
 165       if Style_Check_Comments then
 166          if Style_Check_Comments_Spacing = 2 then
 167             Add ('c', Style_Check_Comments);
 168          elsif Style_Check_Comments_Spacing = 1 then
 169             Add ('C', Style_Check_Comments);
 170          end if;
 171       end if;
 172
 173       Add ('d', Style_Check_DOS_Line_Terminator);
 174       Add ('e', Style_Check_End_Labels);
 175       Add ('f', Style_Check_Form_Feeds);
 176       Add ('h', Style_Check_Horizontal_Tabs);
 177       Add ('i', Style_Check_If_Then_Layout);
 178       Add ('I', Style_Check_Mode_In);
 179       Add ('k', Style_Check_Keyword_Casing);
 180       Add ('l', Style_Check_Layout);
 181       Add ('n', Style_Check_Standard);
 182       Add ('o', Style_Check_Order_Subprograms);
 183       Add ('O', Style_Check_Missing_Overriding);
 184       Add ('p', Style_Check_Pragma_Casing);
 185       Add ('r', Style_Check_References);
 186       Add ('s', Style_Check_Specs);
 187       Add ('S', Style_Check_Separate_Stmt_Lines);
 188       Add ('t', Style_Check_Tokens);
 189       Add ('u', Style_Check_Blank_Lines);
 190       Add ('x', Style_Check_Xtra_Parens);
 191
 192       if Style_Check_Max_Line_Length then
 193          P := P + 1;
 194          Options (P) := 'M';
 195          Add_Nat (Style_Max_Line_Length);
 196       end if;
 197
 198       if Style_Check_Max_Nesting_Level then
 199          P := P + 1;
 200          Options (P) := 'L';
 201          Add_Nat (Style_Max_Nesting_Level);
 202       end if;
 203
 204       pragma Assert (P <= Options'Last);
 205
 206       while P < Options'Last loop
 207          P := P + 1;
 208          Options (P) := ' ';
 209       end loop;
 210    end Save_Style_Check_Options;
 211
 212    -------------------------------------
 213    -- Set_Default_Style_Check_Options --
 214    -------------------------------------
 215
 216    procedure Set_Default_Style_Check_Options is
 217    begin
 218       Reset_Style_Check_Options;
 219       Set_Style_Check_Options (Default_Style);
 220    end Set_Default_Style_Check_Options;
 221
 222    ----------------------------------
 223    -- Set_GNAT_Style_Check_Options --
 224    ----------------------------------
 225
 226    procedure Set_GNAT_Style_Check_Options is
 227    begin
 228       Reset_Style_Check_Options;
 229       Set_Style_Check_Options (GNAT_Style);
 230    end Set_GNAT_Style_Check_Options;
 231
 232    -----------------------------
 233    -- Set_Style_Check_Options --
 234    -----------------------------
 235
 236    --  Version used when no error checking is required
 237
 238    procedure Set_Style_Check_Options (Options : String) is
 239       OK : Boolean;
 240       EC : Natural;
 241       pragma Warnings (Off, EC);
 242    begin
 243       Set_Style_Check_Options (Options, OK, EC);
 244       pragma Assert (OK);
 245    end Set_Style_Check_Options;
 246
 247    --  Normal version with error checking
 248
 249    procedure Set_Style_Check_Options
 250      (Options  : String;
 251       OK       : out Boolean;
 252       Err_Col  : out Natural)
 253    is
 254       C : Character;
 255
 256       On : Boolean := True;
 257       --  Set to False if minus encountered
 258       --  Set to True if plus encountered
 259
 260       Last_Option : Character := ' ';
 261       --  Set to last character encountered
 262
 263       procedure Add_Img (N : Natural);
 264       --  Concatenates image of N at end of Style_Msg_Buf
 265
 266       procedure Bad_Style_Switch (Msg : String);
 267       --  Called if bad style switch found. Msg is set in Style_Msg_Buf and
 268       --  Style_Msg_Len. OK is set False.
 269
 270       -------------
 271       -- Add_Img --
 272       -------------
 273
 274       procedure Add_Img (N : Natural) is
 275       begin
 276          if N >= 10 then
 277             Add_Img (N / 10);
 278          end if;
 279
 280          Style_Msg_Len := Style_Msg_Len + 1;
 281          Style_Msg_Buf (Style_Msg_Len) :=
 282            Character'Val (N mod 10 + Character'Pos ('0'));
 283       end Add_Img;
 284
 285       ----------------------
 286       -- Bad_Style_Switch --
 287       ----------------------
 288
 289       procedure Bad_Style_Switch (Msg : String) is
 290       begin
 291          OK := False;
 292          Style_Msg_Len := Msg'Length;
 293          Style_Msg_Buf (1 .. Style_Msg_Len) := Msg;
 294       end Bad_Style_Switch;
 295
 296    --  Start of processing for Set_Style_Check_Options
 297
 298    begin
 299       Err_Col := Options'First;
 300       while Err_Col <= Options'Last loop
 301          C := Options (Err_Col);
 302          Last_Option := C;
 303          Err_Col := Err_Col + 1;
 304
 305          --  Turning switches on
 306
 307          if On then
 308             case C is
 309             when '+' =>
 310                null;
 311
 312             when '-' =>
 313                On := False;
 314
 315             when '0' .. '9' =>
 316                Style_Check_Indentation :=
 317                  Character'Pos (C) - Character'Pos ('0');
 318
 319             when 'a' =>
 320                Style_Check_Attribute_Casing      := True;
 321
 322             when 'A' =>
 323                Style_Check_Array_Attribute_Index := True;
 324
 325             when 'b' =>
 326                Style_Check_Blanks_At_End         := True;
 327
 328             when 'B' =>
 329                Style_Check_Boolean_And_Or        := True;
 330
 331             when 'c' =>
 332                Style_Check_Comments              := True;
 333                Style_Check_Comments_Spacing      := 2;
 334
 335             when 'C' =>
 336                Style_Check_Comments              := True;
 337                Style_Check_Comments_Spacing      := 1;
 338
 339             when 'd' =>
 340                Style_Check_DOS_Line_Terminator   := True;
 341
 342             when 'e' =>
 343                Style_Check_End_Labels            := True;
 344
 345             when 'f' =>
 346                Style_Check_Form_Feeds            := True;
 347
 348             when 'g' =>
 349                Set_GNAT_Style_Check_Options;
 350
 351             when 'h' =>
 352                Style_Check_Horizontal_Tabs       := True;
 353
 354             when 'i' =>
 355                Style_Check_If_Then_Layout        := True;
 356
 357             when 'I' =>
 358                Style_Check_Mode_In               := True;
 359
 360             when 'k' =>
 361                Style_Check_Keyword_Casing        := True;
 362
 363             when 'l' =>
 364                Style_Check_Layout                := True;
 365
 366             when 'L' =>
 367                Style_Max_Nesting_Level := 0;
 368
 369                if Err_Col > Options'Last
 370                  or else Options (Err_Col) not in '0' .. '9'
 371                then
 372                   Bad_Style_Switch ("invalid nesting level");
 373                   return;
 374                end if;
 375
 376                loop
 377                   Style_Max_Nesting_Level :=
 378                     Style_Max_Nesting_Level * 10 +
 379                       Character'Pos (Options (Err_Col)) - Character'Pos ('0');
 380
 381                   if Style_Max_Nesting_Level > 999 then
 382                      Bad_Style_Switch
 383                        ("max nesting level (999) exceeded in style check");
 384                      return;
 385                   end if;
 386
 387                   Err_Col := Err_Col + 1;
 388                   exit when Err_Col > Options'Last
 389                     or else Options (Err_Col) not in '0' .. '9';
 390                end loop;
 391
 392                Style_Check_Max_Nesting_Level := Style_Max_Nesting_Level /= 0;
 393
 394             when 'm' =>
 395                Style_Check_Max_Line_Length       := True;
 396                Style_Max_Line_Length             := 79;
 397
 398             when 'M' =>
 399                Style_Max_Line_Length             := 0;
 400
 401                if Err_Col > Options'Last
 402                  or else Options (Err_Col) not in '0' .. '9'
 403                then
 404                   Bad_Style_Switch
 405                     ("invalid line length in style check");
 406                   return;
 407                end if;
 408
 409                loop
 410                   Style_Max_Line_Length :=
 411                     Style_Max_Line_Length * 10 +
 412                       Character'Pos (Options (Err_Col)) - Character'Pos ('0');
 413
 414                   if Style_Max_Line_Length > Int (Max_Line_Length) then
 415                      OK := False;
 416                      Style_Msg_Buf (1 .. 27) := "max line length allowed is ";
 417                      Style_Msg_Len := 27;
 418                      Add_Img (Natural (Max_Line_Length));
 419                      return;
 420                   end if;
 421
 422                   Err_Col := Err_Col + 1;
 423                   exit when Err_Col > Options'Last
 424                     or else Options (Err_Col) not in '0' .. '9';
 425                end loop;
 426
 427                Style_Check_Max_Line_Length       := Style_Max_Line_Length /= 0;
 428
 429             when 'n' =>
 430                Style_Check_Standard              := True;
 431
 432             when 'N' =>
 433                Reset_Style_Check_Options;
 434
 435             when 'o' =>
 436                Style_Check_Order_Subprograms     := True;
 437
 438             when 'O' =>
 439                Style_Check_Missing_Overriding    := True;
 440
 441             when 'p' =>
 442                Style_Check_Pragma_Casing         := True;
 443
 444             when 'r' =>
 445                Style_Check_References            := True;
 446
 447             when 's' =>
 448                Style_Check_Specs                 := True;
 449
 450             when 'S' =>
 451                Style_Check_Separate_Stmt_Lines   := True;
 452
 453             when 't' =>
 454                Style_Check_Tokens                := True;
 455
 456             when 'u' =>
 457                Style_Check_Blank_Lines           := True;
 458
 459             when 'x' =>
 460                Style_Check_Xtra_Parens           := True;
 461
 462             when 'y' =>
 463                Set_Default_Style_Check_Options;
 464
 465             when ' ' =>
 466                null;
 467
 468             when others =>
 469                if Ignore_Unrecognized_VWY_Switches then
 470                   Write_Line ("unrecognized switch -gnaty" & C & " ignored");
 471                else
 472                   Err_Col := Err_Col - 1;
 473                   Bad_Style_Switch ("invalid style switch");
 474                   return;
 475                end if;
 476             end case;
 477
 478          --  Turning switches off
 479
 480          else
 481             case C is
 482             when '+' =>
 483                On := True;
 484
 485             when '-' =>
 486                null;
 487
 488             when '0' .. '9' =>
 489                Style_Check_Indentation := 0;
 490
 491             when 'a' =>
 492                Style_Check_Attribute_Casing      := False;
 493
 494             when 'A' =>
 495                Style_Check_Array_Attribute_Index := False;
 496
 497             when 'b' =>
 498                Style_Check_Blanks_At_End         := False;
 499
 500             when 'B' =>
 501                Style_Check_Boolean_And_Or        := False;
 502
 503             when 'c' | 'C' =>
 504                Style_Check_Comments              := False;
 505
 506             when 'd' =>
 507                Style_Check_DOS_Line_Terminator   := False;
 508
 509             when 'e' =>
 510                Style_Check_End_Labels            := False;
 511
 512             when 'f' =>
 513                Style_Check_Form_Feeds            := False;
 514
 515             when 'g' =>
 516                Reset_Style_Check_Options;
 517
 518             when 'h' =>
 519                Style_Check_Horizontal_Tabs       := False;
 520
 521             when 'i' =>
 522                Style_Check_If_Then_Layout        := False;
 523
 524             when 'I' =>
 525                Style_Check_Mode_In               := False;
 526
 527             when 'k' =>
 528                Style_Check_Keyword_Casing        := False;
 529
 530             when 'l' =>
 531                Style_Check_Layout                := False;
 532
 533             when 'L' =>
 534                Style_Max_Nesting_Level := 0;
 535
 536             when 'm' =>
 537                Style_Check_Max_Line_Length       := False;
 538
 539             when 'M' =>
 540                Style_Max_Line_Length             := 0;
 541                Style_Check_Max_Line_Length       := False;
 542
 543             when 'n' =>
 544                Style_Check_Standard              := False;
 545
 546             when 'o' =>
 547                Style_Check_Order_Subprograms     := False;
 548
 549             when 'O' =>
 550                Style_Check_Missing_Overriding    := False;
 551
 552             when 'p' =>
 553                Style_Check_Pragma_Casing         := False;
 554
 555             when 'r' =>
 556                Style_Check_References            := False;
 557
 558             when 's' =>
 559                Style_Check_Specs                 := False;
 560
 561             when 'S' =>
 562                Style_Check_Separate_Stmt_Lines   := False;
 563
 564             when 't' =>
 565                Style_Check_Tokens                := False;
 566
 567             when 'u' =>
 568                Style_Check_Blank_Lines           := False;
 569
 570             when 'x' =>
 571                Style_Check_Xtra_Parens           := False;
 572
 573             when ' ' =>
 574                null;
 575
 576             when others =>
 577                if Ignore_Unrecognized_VWY_Switches then
 578                   Write_Line ("unrecognized switch -gnaty-" & C & " ignored");
 579                else
 580                   Err_Col := Err_Col - 1;
 581                   Bad_Style_Switch ("invalid style switch");
 582                   return;
 583                end if;
 584             end case;
 585          end if;
 586       end loop;
 587
 588       --  Turn on style checking if other than N at end of string
 589
 590       Style_Check := (Last_Option /= 'N');
 591       OK := True;
 592    end Set_Style_Check_Options;
 593 end Stylesw;