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-2018, 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       Add (Character'Val (Style_Check_Indentation + Character'Pos ('0')),
 154            Style_Check_Indentation /= 0);
 155
 156       Add ('a', Style_Check_Attribute_Casing);
 157       Add ('A', Style_Check_Array_Attribute_Index);
 158       Add ('b', Style_Check_Blanks_At_End);
 159       Add ('B', Style_Check_Boolean_And_Or);
 160
 161       if Style_Check_Comments then
 162          if Style_Check_Comments_Spacing = 2 then
 163             Add ('c', Style_Check_Comments);
 164          else
 165             pragma Assert (Style_Check_Comments_Spacing = 1);
 166             Add ('C', Style_Check_Comments);
 167          end if;
 168       end if;
 169
 170       Add ('d', Style_Check_DOS_Line_Terminator);
 171       Add ('e', Style_Check_End_Labels);
 172       Add ('f', Style_Check_Form_Feeds);
 173       Add ('h', Style_Check_Horizontal_Tabs);
 174       Add ('i', Style_Check_If_Then_Layout);
 175       Add ('I', Style_Check_Mode_In);
 176       Add ('k', Style_Check_Keyword_Casing);
 177       Add ('l', Style_Check_Layout);
 178       Add ('n', Style_Check_Standard);
 179       Add ('o', Style_Check_Order_Subprograms);
 180       Add ('O', Style_Check_Missing_Overriding);
 181       Add ('p', Style_Check_Pragma_Casing);
 182       Add ('r', Style_Check_References);
 183       Add ('s', Style_Check_Specs);
 184       Add ('S', Style_Check_Separate_Stmt_Lines);
 185       Add ('t', Style_Check_Tokens);
 186       Add ('u', Style_Check_Blank_Lines);
 187       Add ('x', Style_Check_Xtra_Parens);
 188
 189       if Style_Check_Max_Line_Length then
 190          P := P + 1;
 191          Options (P) := 'M';
 192          Add_Nat (Style_Max_Line_Length);
 193       end if;
 194
 195       if Style_Check_Max_Nesting_Level then
 196          P := P + 1;
 197          Options (P) := 'L';
 198          Add_Nat (Style_Max_Nesting_Level);
 199       end if;
 200
 201       pragma Assert (P <= Options'Last);
 202
 203       while P < Options'Last loop
 204          P := P + 1;
 205          Options (P) := ' ';
 206       end loop;
 207    end Save_Style_Check_Options;
 208
 209    -------------------------------------
 210    -- Set_Default_Style_Check_Options --
 211    -------------------------------------
 212
 213    procedure Set_Default_Style_Check_Options is
 214    begin
 215       Reset_Style_Check_Options;
 216       Set_Style_Check_Options (Default_Style);
 217    end Set_Default_Style_Check_Options;
 218
 219    ----------------------------------
 220    -- Set_GNAT_Style_Check_Options --
 221    ----------------------------------
 222
 223    procedure Set_GNAT_Style_Check_Options is
 224    begin
 225       Reset_Style_Check_Options;
 226       Set_Style_Check_Options (GNAT_Style);
 227    end Set_GNAT_Style_Check_Options;
 228
 229    -----------------------------
 230    -- Set_Style_Check_Options --
 231    -----------------------------
 232
 233    --  Version used when no error checking is required
 234
 235    procedure Set_Style_Check_Options (Options : String) is
 236       OK : Boolean;
 237       EC : Natural;
 238       pragma Warnings (Off, EC);
 239    begin
 240       Set_Style_Check_Options (Options, OK, EC);
 241       pragma Assert (OK);
 242    end Set_Style_Check_Options;
 243
 244    --  Normal version with error checking
 245
 246    procedure Set_Style_Check_Options
 247      (Options  : String;
 248       OK       : out Boolean;
 249       Err_Col  : out Natural)
 250    is
 251       C : Character;
 252
 253       On : Boolean := True;
 254       --  Set to False if minus encountered
 255       --  Set to True if plus encountered
 256
 257       Last_Option : Character := ' ';
 258       --  Set to last character encountered
 259
 260       procedure Add_Img (N : Natural);
 261       --  Concatenates image of N at end of Style_Msg_Buf
 262
 263       procedure Bad_Style_Switch (Msg : String);
 264       --  Called if bad style switch found. Msg is set in Style_Msg_Buf and
 265       --  Style_Msg_Len. OK is set False.
 266
 267       -------------
 268       -- Add_Img --
 269       -------------
 270
 271       procedure Add_Img (N : Natural) is
 272       begin
 273          if N >= 10 then
 274             Add_Img (N / 10);
 275          end if;
 276
 277          Style_Msg_Len := Style_Msg_Len + 1;
 278          Style_Msg_Buf (Style_Msg_Len) :=
 279            Character'Val (N mod 10 + Character'Pos ('0'));
 280       end Add_Img;
 281
 282       ----------------------
 283       -- Bad_Style_Switch --
 284       ----------------------
 285
 286       procedure Bad_Style_Switch (Msg : String) is
 287       begin
 288          OK := False;
 289          Style_Msg_Len := Msg'Length;
 290          Style_Msg_Buf (1 .. Style_Msg_Len) := Msg;
 291       end Bad_Style_Switch;
 292
 293    --  Start of processing for Set_Style_Check_Options
 294
 295    begin
 296       Err_Col := Options'First;
 297       while Err_Col <= Options'Last loop
 298          C := Options (Err_Col);
 299          Last_Option := C;
 300          Err_Col := Err_Col + 1;
 301
 302          --  Turning switches on
 303
 304          if On then
 305             case C is
 306             when '+' =>
 307                null;
 308
 309             when '-' =>
 310                On := False;
 311
 312             when '0' .. '9' =>
 313                Style_Check_Indentation :=
 314                  Character'Pos (C) - Character'Pos ('0');
 315
 316             when 'a' =>
 317                Style_Check_Attribute_Casing      := True;
 318
 319             when 'A' =>
 320                Style_Check_Array_Attribute_Index := True;
 321
 322             when 'b' =>
 323                Style_Check_Blanks_At_End         := True;
 324
 325             when 'B' =>
 326                Style_Check_Boolean_And_Or        := True;
 327
 328             when 'c' =>
 329                Style_Check_Comments              := True;
 330                Style_Check_Comments_Spacing      := 2;
 331
 332             when 'C' =>
 333                Style_Check_Comments              := True;
 334                Style_Check_Comments_Spacing      := 1;
 335
 336             when 'd' =>
 337                Style_Check_DOS_Line_Terminator   := True;
 338
 339             when 'e' =>
 340                Style_Check_End_Labels            := True;
 341
 342             when 'f' =>
 343                Style_Check_Form_Feeds            := True;
 344
 345             when 'g' =>
 346                Set_GNAT_Style_Check_Options;
 347
 348             when 'h' =>
 349                Style_Check_Horizontal_Tabs       := True;
 350
 351             when 'i' =>
 352                Style_Check_If_Then_Layout        := True;
 353
 354             when 'I' =>
 355                Style_Check_Mode_In               := True;
 356
 357             when 'k' =>
 358                Style_Check_Keyword_Casing        := True;
 359
 360             when 'l' =>
 361                Style_Check_Layout                := True;
 362
 363             when 'L' =>
 364                Style_Max_Nesting_Level := 0;
 365
 366                if Err_Col > Options'Last
 367                  or else Options (Err_Col) not in '0' .. '9'
 368                then
 369                   Bad_Style_Switch ("invalid nesting level");
 370                   return;
 371                end if;
 372
 373                loop
 374                   Style_Max_Nesting_Level :=
 375                     Style_Max_Nesting_Level * 10 +
 376                       Character'Pos (Options (Err_Col)) - Character'Pos ('0');
 377
 378                   if Style_Max_Nesting_Level > 999 then
 379                      Bad_Style_Switch
 380                        ("max nesting level (999) exceeded in style check");
 381                      return;
 382                   end if;
 383
 384                   Err_Col := Err_Col + 1;
 385                   exit when Err_Col > Options'Last
 386                     or else Options (Err_Col) not in '0' .. '9';
 387                end loop;
 388
 389                Style_Check_Max_Nesting_Level := Style_Max_Nesting_Level /= 0;
 390
 391             when 'm' =>
 392                Style_Check_Max_Line_Length       := True;
 393                Style_Max_Line_Length             := 79;
 394
 395             when 'M' =>
 396                Style_Max_Line_Length             := 0;
 397
 398                if Err_Col > Options'Last
 399                  or else Options (Err_Col) not in '0' .. '9'
 400                then
 401                   Bad_Style_Switch
 402                     ("invalid line length in style check");
 403                   return;
 404                end if;
 405
 406                loop
 407                   Style_Max_Line_Length :=
 408                     Style_Max_Line_Length * 10 +
 409                       Character'Pos (Options (Err_Col)) - Character'Pos ('0');
 410
 411                   if Style_Max_Line_Length > Int (Max_Line_Length) then
 412                      OK := False;
 413                      Style_Msg_Buf (1 .. 27) := "max line length allowed is ";
 414                      Style_Msg_Len := 27;
 415                      Add_Img (Natural (Max_Line_Length));
 416                      return;
 417                   end if;
 418
 419                   Err_Col := Err_Col + 1;
 420                   exit when Err_Col > Options'Last
 421                     or else Options (Err_Col) not in '0' .. '9';
 422                end loop;
 423
 424                Style_Check_Max_Line_Length       := Style_Max_Line_Length /= 0;
 425
 426             when 'n' =>
 427                Style_Check_Standard              := True;
 428
 429             when 'N' =>
 430                Reset_Style_Check_Options;
 431
 432             when 'o' =>
 433                Style_Check_Order_Subprograms     := True;
 434
 435             when 'O' =>
 436                Style_Check_Missing_Overriding    := True;
 437
 438             when 'p' =>
 439                Style_Check_Pragma_Casing         := True;
 440
 441             when 'r' =>
 442                Style_Check_References            := True;
 443
 444             when 's' =>
 445                Style_Check_Specs                 := True;
 446
 447             when 'S' =>
 448                Style_Check_Separate_Stmt_Lines   := True;
 449
 450             when 't' =>
 451                Style_Check_Tokens                := True;
 452
 453             when 'u' =>
 454                Style_Check_Blank_Lines           := True;
 455
 456             when 'x' =>
 457                Style_Check_Xtra_Parens           := True;
 458
 459             when 'y' =>
 460                Set_Default_Style_Check_Options;
 461
 462             when ' ' =>
 463                null;
 464
 465             when others =>
 466                if Ignore_Unrecognized_VWY_Switches then
 467                   Write_Line ("unrecognized switch -gnaty" & C & " ignored");
 468                else
 469                   Err_Col := Err_Col - 1;
 470                   Bad_Style_Switch ("invalid style switch");
 471                   return;
 472                end if;
 473             end case;
 474
 475          --  Turning switches off
 476
 477          else
 478             case C is
 479             when '+' =>
 480                On := True;
 481
 482             when '-' =>
 483                null;
 484
 485             when '0' .. '9' =>
 486                Style_Check_Indentation := 0;
 487
 488             when 'a' =>
 489                Style_Check_Attribute_Casing      := False;
 490
 491             when 'A' =>
 492                Style_Check_Array_Attribute_Index := False;
 493
 494             when 'b' =>
 495                Style_Check_Blanks_At_End         := False;
 496
 497             when 'B' =>
 498                Style_Check_Boolean_And_Or        := False;
 499
 500             when 'c' | 'C' =>
 501                Style_Check_Comments              := False;
 502
 503             when 'd' =>
 504                Style_Check_DOS_Line_Terminator   := False;
 505
 506             when 'e' =>
 507                Style_Check_End_Labels            := False;
 508
 509             when 'f' =>
 510                Style_Check_Form_Feeds            := False;
 511
 512             when 'g' =>
 513                Reset_Style_Check_Options;
 514
 515             when 'h' =>
 516                Style_Check_Horizontal_Tabs       := False;
 517
 518             when 'i' =>
 519                Style_Check_If_Then_Layout        := False;
 520
 521             when 'I' =>
 522                Style_Check_Mode_In               := False;
 523
 524             when 'k' =>
 525                Style_Check_Keyword_Casing        := False;
 526
 527             when 'l' =>
 528                Style_Check_Layout                := False;
 529
 530             when 'L' =>
 531                Style_Max_Nesting_Level := 0;
 532
 533             when 'm' =>
 534                Style_Check_Max_Line_Length       := False;
 535
 536             when 'M' =>
 537                Style_Max_Line_Length             := 0;
 538                Style_Check_Max_Line_Length       := False;
 539
 540             when 'n' =>
 541                Style_Check_Standard              := False;
 542
 543             when 'o' =>
 544                Style_Check_Order_Subprograms     := False;
 545
 546             when 'O' =>
 547                Style_Check_Missing_Overriding    := False;
 548
 549             when 'p' =>
 550                Style_Check_Pragma_Casing         := False;
 551
 552             when 'r' =>
 553                Style_Check_References            := False;
 554
 555             when 's' =>
 556                Style_Check_Specs                 := False;
 557
 558             when 'S' =>
 559                Style_Check_Separate_Stmt_Lines   := False;
 560
 561             when 't' =>
 562                Style_Check_Tokens                := False;
 563
 564             when 'u' =>
 565                Style_Check_Blank_Lines           := False;
 566
 567             when 'x' =>
 568                Style_Check_Xtra_Parens           := False;
 569
 570             when ' ' =>
 571                null;
 572
 573             when others =>
 574                if Ignore_Unrecognized_VWY_Switches then
 575                   Write_Line ("unrecognized switch -gnaty-" & C & " ignored");
 576                else
 577                   Err_Col := Err_Col - 1;
 578                   Bad_Style_Switch ("invalid style switch");
 579                   return;
 580                end if;
 581             end case;
 582          end if;
 583       end loop;
 584
 585       --  Turn on style checking if other than N at end of string
 586
 587       Style_Check := (Last_Option /= 'N');
 588       OK := True;
 589    end Set_Style_Check_Options;
 590 end Stylesw;