gcc/ada/styleg.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               S T Y L E G                                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2007, 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 --  This version of the Style package implements the standard GNAT style
  27 --  checking rules. For documentation of these rules, see comments on the
  28 --  individual procedures.
  29
  30 with Casing;   use Casing;
  31 with Csets;    use Csets;
  32 with Err_Vars; use Err_Vars;
  33 with Opt;      use Opt;
  34 with Scans;    use Scans;
  35 with Sinput;   use Sinput;
  36 with Stylesw;  use Stylesw;
  37
  38 package body Styleg is
  39
  40    use ASCII;
  41
  42    Blank_Lines : Nat := 0;
  43    --  Counts number of empty lines seen. Reset to zero if a non-empty line
  44    --  is encountered. Used to check for trailing blank lines in Check_EOF,
  45    --  and for multiple blank lines.
  46
  47    Blank_Line_Location : Source_Ptr;
  48    --  Remembers location of first blank line in a series. Used to issue an
  49    --  appropriate diagnostic if subsequent blank lines or the end of file
  50    --  is encountered.
  51
  52    -----------------------
  53    -- Local Subprograms --
  54    -----------------------
  55
  56    procedure Check_No_Space_After;
  57    --  Checks that there is a non-white space character after the current
  58    --  token, or white space followed by a comment, or the end of line.
  59    --  Issue error message if not.
  60
  61    procedure Check_No_Space_Before;
  62    --  Check that token is first token on line, or else is not preceded
  63    --  by white space. Signal error of space not allowed if not.
  64
  65    procedure Check_Separate_Stmt_Lines_Cont;
  66    --  Non-inlined continuation of Check_Separate_Stmt_Lines
  67
  68    function Determine_Token_Casing return Casing_Type;
  69    --  Determine casing of current token
  70
  71    procedure Error_Space_Not_Allowed (S : Source_Ptr);
  72    --  Posts an error message indicating that a space is not allowed
  73    --  at the given source location.
  74
  75    procedure Error_Space_Required (S : Source_Ptr);
  76    --  Posts an error message indicating that a space is required at
  77    --  the given source location.
  78
  79    function Is_White_Space (C : Character) return Boolean;
  80    pragma Inline (Is_White_Space);
  81    --  Returns True for space, HT, VT or FF, False otherwise
  82
  83    procedure Require_Following_Space;
  84    pragma Inline (Require_Following_Space);
  85    --  Require token to be followed by white space. Used only if in GNAT
  86    --  style checking mode.
  87
  88    procedure Require_Preceding_Space;
  89    pragma Inline (Require_Preceding_Space);
  90    --  Require token to be preceded by white space. Used only if in GNAT
  91    --  style checking mode.
  92
  93    ----------------------
  94    -- Check_Abs_Or_Not --
  95    ----------------------
  96
  97    --  In check tokens mode (-gnatyt), ABS/NOT must be followed by a space
  98
  99    procedure Check_Abs_Not is
 100    begin
 101       if Style_Check_Tokens then
 102          if Source (Scan_Ptr) > ' ' then
 103             Error_Space_Required (Scan_Ptr);
 104          end if;
 105       end if;
 106    end Check_Abs_Not;
 107
 108    ----------------------
 109    -- Check_Apostrophe --
 110    ----------------------
 111
 112    --  Do not allow space before or after apostrophe
 113
 114    procedure Check_Apostrophe is
 115    begin
 116       if Style_Check_Tokens then
 117          Check_No_Space_After;
 118       end if;
 119    end Check_Apostrophe;
 120
 121    -----------------
 122    -- Check_Arrow --
 123    -----------------
 124
 125    --  In check tokens mode (-gnatys), arrow must be surrounded by spaces
 126
 127    procedure Check_Arrow is
 128    begin
 129       if Style_Check_Tokens then
 130          Require_Preceding_Space;
 131          Require_Following_Space;
 132       end if;
 133    end Check_Arrow;
 134
 135    --------------------------
 136    -- Check_Attribute_Name --
 137    --------------------------
 138
 139    --  In check attribute casing mode (-gnatya), attribute names must be
 140    --  mixed case, i.e. start with an upper case letter, and otherwise
 141    --  lower case, except after an underline character.
 142
 143    procedure Check_Attribute_Name (Reserved : Boolean) is
 144       pragma Warnings (Off, Reserved);
 145    begin
 146       if Style_Check_Attribute_Casing then
 147          if Determine_Token_Casing /= Mixed_Case then
 148             Error_Msg_SC ("(style) bad capitalization, mixed case required");
 149          end if;
 150       end if;
 151    end Check_Attribute_Name;
 152
 153    ---------------------------
 154    -- Check_Binary_Operator --
 155    ---------------------------
 156
 157    --  In check token mode (-gnatyt), binary operators other than the special
 158    --  case of exponentiation require surrounding space characters.
 159
 160    procedure Check_Binary_Operator is
 161    begin
 162       if Style_Check_Tokens then
 163          Require_Preceding_Space;
 164          Require_Following_Space;
 165       end if;
 166    end Check_Binary_Operator;
 167
 168    ---------------
 169    -- Check_Box --
 170    ---------------
 171
 172    --  In check token mode (-gnatyt), box must be preceded by a space or by
 173    --  a left parenthesis. Spacing checking on the surrounding tokens takes
 174    --  care of the remaining checks.
 175
 176    procedure Check_Box is
 177    begin
 178       if Style_Check_Tokens then
 179          if Prev_Token /= Tok_Left_Paren then
 180             Require_Preceding_Space;
 181          end if;
 182       end if;
 183    end Check_Box;
 184
 185    -----------------
 186    -- Check_Colon --
 187    -----------------
 188
 189    --  In check token mode (-gnatyt), colon must be surrounded by spaces
 190
 191    procedure Check_Colon is
 192    begin
 193       if Style_Check_Tokens then
 194          Require_Preceding_Space;
 195          Require_Following_Space;
 196       end if;
 197    end Check_Colon;
 198
 199    -----------------------
 200    -- Check_Colon_Equal --
 201    -----------------------
 202
 203    --  In check token mode (-gnatyt), := must be surrounded by spaces
 204
 205    procedure Check_Colon_Equal is
 206    begin
 207       if Style_Check_Tokens then
 208          Require_Preceding_Space;
 209          Require_Following_Space;
 210       end if;
 211    end Check_Colon_Equal;
 212
 213    -----------------
 214    -- Check_Comma --
 215    -----------------
 216
 217    --  In check token mode (-gnatyt), comma must be either the first
 218    --  token on a line, or be preceded by a non-blank character.
 219    --  It must also always be followed by a blank.
 220
 221    procedure Check_Comma is
 222    begin
 223       if Style_Check_Tokens then
 224          Check_No_Space_Before;
 225
 226          if Source (Scan_Ptr) > ' ' then
 227             Error_Space_Required (Scan_Ptr);
 228          end if;
 229       end if;
 230    end Check_Comma;
 231
 232    -------------------
 233    -- Check_Comment --
 234    -------------------
 235
 236    --  In check comment mode (-gnatyc) there are several requirements on the
 237    --  format of comments. The following are permissible comment formats:
 238
 239    --    1. Any comment that is not at the start of a line, i.e. where the
 240    --       initial minuses are not the first non-blank characters on the
 241    --       line must have at least one blank after the second minus.
 242
 243    --    2. A row of all minuses of any length is permitted (see procedure
 244    --       box above in the source of this routine).
 245
 246    --    3. A comment line starting with two minuses and a space, and ending
 247    --       with a space and two minuses. Again see the procedure title box
 248    --       immediately above in the source.
 249
 250    --    4. A full line comment where two spaces follow the two minus signs.
 251    --       This is the normal comment format in GNAT style, as typified by
 252    --       the comments you are reading now.
 253
 254    --    5. A full line comment where the first character after the second
 255    --       minus is a special character, i.e. a character in the ASCII
 256    --       range 16#21#..16#2F# or 16#3A#..16#3F#. This allows special
 257    --       comments, such as those generated by gnatprep, or those that
 258    --       appear in the SPARK annotation language to be accepted.
 259
 260    --       Note: for GNAT internal files (-gnatg switch set on for the
 261    --       compilation), the only special sequence recognized and allowed
 262    --       is --! as generated by gnatprep.
 263
 264    --    6. In addition, the comment must be properly indented if comment
 265    --       indentation checking is active (Style_Check_Indentation non-zero).
 266    --       Either the start column must be a multiple of this indentation,
 267    --       or the indentation must match that of the next non-blank line.
 268
 269    procedure Check_Comment is
 270       S : Source_Ptr;
 271       C : Character;
 272
 273       function Is_Box_Comment return Boolean;
 274       --  Returns True if the last two characters on the line are -- which
 275       --  characterizes a box comment (as for example follows this spec).
 276
 277       function Same_Column_As_Next_Non_Blank_Line return Boolean;
 278       --  Called for a full line comment. If the indentation of this commment
 279       --  matches that of the next non-blank line in the source, then True is
 280       --  returned, otherwise False.
 281
 282       --------------------
 283       -- Is_Box_Comment --
 284       --------------------
 285
 286       function Is_Box_Comment return Boolean is
 287          S : Source_Ptr;
 288
 289       begin
 290          --  Do we need to worry about UTF_32 line terminators here ???
 291
 292          S := Scan_Ptr + 3;
 293          while Source (S) not in Line_Terminator loop
 294             S := S + 1;
 295          end loop;
 296
 297          return Source (S - 1) = '-' and then Source (S - 2) = '-';
 298       end Is_Box_Comment;
 299
 300       ----------------------------------------
 301       -- Same_Column_As_Next_Non_Blank_Line --
 302       ----------------------------------------
 303
 304       function Same_Column_As_Next_Non_Blank_Line return Boolean is
 305          P : Source_Ptr;
 306
 307       begin
 308          --  Step to end of line
 309
 310          P := Scan_Ptr + 2;
 311          while Source (P) not in Line_Terminator loop
 312             P := P + 1;
 313          end loop;
 314
 315          --  Step past blanks, and line terminators (UTF_32 case???)
 316
 317          while Source (P) <= ' ' and then Source (P) /= EOF loop
 318             P := P + 1;
 319          end loop;
 320
 321          --  Compare columns
 322
 323          return Get_Column_Number (Scan_Ptr) = Get_Column_Number (P);
 324       end Same_Column_As_Next_Non_Blank_Line;
 325
 326    --  Start of processing for Check_Comment
 327
 328    begin
 329       --  Can never have a non-blank character preceding the first minus
 330
 331       if Style_Check_Comments then
 332          if Scan_Ptr > Source_First (Current_Source_File)
 333            and then Source (Scan_Ptr - 1) > ' '
 334          then
 335             Error_Msg_S ("(style) space required");
 336          end if;
 337       end if;
 338
 339       --  For a comment that is not at the start of the line, the only
 340       --  requirement is that we cannot have a non-blank character after
 341       --  the second minus sign.
 342
 343       if Scan_Ptr /= First_Non_Blank_Location then
 344          if Style_Check_Comments then
 345             if Source (Scan_Ptr + 2) > ' ' then
 346                Error_Msg ("(style) space required", Scan_Ptr + 2);
 347             end if;
 348          end if;
 349
 350          return;
 351
 352       --  Case of a comment that is at the start of a line
 353
 354       else
 355          --  First check, must be in appropriately indented column
 356
 357          if Style_Check_Indentation /= 0 then
 358             if Start_Column rem Style_Check_Indentation /= 0 then
 359                if not Same_Column_As_Next_Non_Blank_Line then
 360                   Error_Msg_S ("(style) bad column");
 361                end if;
 362
 363                return;
 364             end if;
 365          end if;
 366
 367          --  If we are not checking comments, nothing more to do
 368
 369          if not Style_Check_Comments then
 370             return;
 371          end if;
 372
 373          --  Case of not followed by a blank. Usually wrong, but there are
 374          --  some exceptions that we permit.
 375
 376          if Source (Scan_Ptr + 2) /= ' ' then
 377             C := Source (Scan_Ptr + 2);
 378
 379             --  Case of -- all on its own on a line is OK
 380
 381             if C < ' ' then
 382                return;
 383             end if;
 384
 385             --  Case of --x, x special character is OK (gnatprep/SPARK/etc.)
 386             --  This is not permitted in internal GNAT implementation units
 387             --  except for the case of --! as used by gnatprep output.
 388
 389             if GNAT_Mode then
 390                if C = '!' then
 391                   return;
 392                end if;
 393
 394             else
 395                if Character'Pos (C) in 16#21# .. 16#2F#
 396                     or else
 397                   Character'Pos (C) in 16#3A# .. 16#3F#
 398                then
 399                   return;
 400                end if;
 401             end if;
 402
 403             --  The only other case in which we allow a character after
 404             --  the -- other than a space is when we have a row of minus
 405             --  signs (case of header lines for a box comment for example).
 406
 407             S := Scan_Ptr + 2;
 408             while Source (S) >= ' ' loop
 409                if Source (S) /= '-' then
 410                   if Is_Box_Comment then
 411                      Error_Space_Required (Scan_Ptr + 2);
 412                   else
 413                      Error_Msg ("(style) two spaces required", Scan_Ptr + 2);
 414                   end if;
 415
 416                   return;
 417                end if;
 418
 419                S := S + 1;
 420             end loop;
 421
 422          --  If we are followed by a blank, then the comment is OK if the
 423          --  character following this blank is another blank or a format
 424          --  effector.
 425
 426          elsif Source (Scan_Ptr + 3) <= ' ' then
 427             return;
 428
 429          --  Here is the case where we only have one blank after the two
 430          --  minus signs, which is an error unless the line ends with two
 431          --  minus signs, the case of a box comment.
 432
 433          elsif not Is_Box_Comment then
 434             Error_Space_Required (Scan_Ptr + 3);
 435          end if;
 436       end if;
 437    end Check_Comment;
 438
 439    -------------------
 440    -- Check_Dot_Dot --
 441    -------------------
 442
 443    --  In check token mode (-gnatyt), colon must be surrounded by spaces
 444
 445    procedure Check_Dot_Dot is
 446    begin
 447       if Style_Check_Tokens then
 448          Require_Preceding_Space;
 449          Require_Following_Space;
 450       end if;
 451    end Check_Dot_Dot;
 452
 453    ---------------
 454    -- Check_EOF --
 455    ---------------
 456
 457    --  In check blanks at end mode, check no blank lines precede the EOF
 458
 459    procedure Check_EOF is
 460    begin
 461       if Style_Check_Blank_Lines then
 462
 463          --  We expect one blank line, from the EOF, but no more than one
 464
 465          if Blank_Lines = 2 then
 466             Error_Msg
 467               ("(style) blank line not allowed at end of file",
 468                Blank_Line_Location);
 469
 470          elsif Blank_Lines >= 3 then
 471             Error_Msg
 472               ("(style) blank lines not allowed at end of file",
 473                Blank_Line_Location);
 474          end if;
 475       end if;
 476    end Check_EOF;
 477
 478    -----------------------------------
 479    -- Check_Exponentiation_Operator --
 480    -----------------------------------
 481
 482    --  No spaces are required for the ** operator in GNAT style check mode
 483
 484    procedure Check_Exponentiation_Operator is
 485    begin
 486       null;
 487    end Check_Exponentiation_Operator;
 488
 489    --------------
 490    -- Check_HT --
 491    --------------
 492
 493    --  In check horizontal tab mode (-gnatyh), tab characters are not allowed
 494
 495    procedure Check_HT is
 496    begin
 497       if Style_Check_Horizontal_Tabs then
 498          Error_Msg_S ("(style) horizontal tab not allowed");
 499       end if;
 500    end Check_HT;
 501
 502    -----------------------
 503    -- Check_Indentation --
 504    -----------------------
 505
 506    --  In check indentation mode (-gnatyn for n a digit), a new statement or
 507    --  declaration is required to start in a column that is a multiple of the
 508    --  indentiation amount.
 509
 510    procedure Check_Indentation is
 511    begin
 512       if Style_Check_Indentation /= 0 then
 513          if Token_Ptr = First_Non_Blank_Location
 514            and then Start_Column rem Style_Check_Indentation /= 0
 515          then
 516             Error_Msg_SC ("(style) bad indentation");
 517          end if;
 518       end if;
 519    end Check_Indentation;
 520
 521    ----------------------
 522    -- Check_Left_Paren --
 523    ----------------------
 524
 525    --  In tone check mode (-gnatyt), left paren must not be preceded by an
 526    --  identifier character or digit (a separating space is required) and
 527    --  may never be followed by a space.
 528
 529    procedure Check_Left_Paren is
 530    begin
 531       if Style_Check_Tokens then
 532          if Token_Ptr > Source_First (Current_Source_File)
 533            and then Identifier_Char (Source (Token_Ptr - 1))
 534          then
 535             Error_Space_Required (Token_Ptr);
 536          end if;
 537
 538          Check_No_Space_After;
 539       end if;
 540    end Check_Left_Paren;
 541
 542    ---------------------------
 543    -- Check_Line_Max_Length --
 544    ---------------------------
 545
 546    --  In check max line length mode (-gnatym), the line length must
 547    --  not exceed the permitted maximum value.
 548
 549    procedure Check_Line_Max_Length (Len : Int) is
 550    begin
 551       if Style_Check_Max_Line_Length then
 552          if Len > Style_Max_Line_Length then
 553             Error_Msg
 554               ("(style) this line is too long",
 555                Current_Line_Start + Source_Ptr (Style_Max_Line_Length));
 556          end if;
 557       end if;
 558    end Check_Line_Max_Length;
 559
 560    ---------------------------
 561    -- Check_Line_Terminator --
 562    ---------------------------
 563
 564    --  In check blanks at end mode (-gnatyb), lines may not end with a
 565    --  trailing space.
 566
 567    --  In check form feeds mode (-gnatyf), the line terminator may not
 568    --  be either of the characters FF or VT.
 569
 570    --  In check DOS line terminators node (-gnatyd), the line terminator
 571    --  must be a single LF, without a following CR.
 572
 573    procedure Check_Line_Terminator (Len : Int) is
 574       S : Source_Ptr;
 575
 576       L : Int := Len;
 577       --  Length of line (adjusted down for blanks at end of line)
 578
 579    begin
 580       --  Reset count of blank lines if first line
 581
 582       if Get_Logical_Line_Number (Scan_Ptr) = 1 then
 583          Blank_Lines := 0;
 584       end if;
 585
 586       --  Check FF/VT terminators
 587
 588       if Style_Check_Form_Feeds then
 589          if Source (Scan_Ptr) = ASCII.FF then
 590             Error_Msg_S ("(style) form feed not allowed");
 591          elsif Source (Scan_Ptr) = ASCII.VT then
 592             Error_Msg_S ("(style) vertical tab not allowed");
 593          end if;
 594       end if;
 595
 596       --  Check DOS line terminator (ignore EOF, since we only get called
 597       --  with an EOF if it is the last character in the buffer, and was
 598       --  therefore not present in the sources
 599
 600       if Style_Check_DOS_Line_Terminator then
 601          if Source (Scan_Ptr) = EOF then
 602             null;
 603          elsif Source (Scan_Ptr) /= LF
 604            or else Source (Scan_Ptr + 1) = CR
 605          then
 606             Error_Msg_S ("(style) incorrect line terminator");
 607          end if;
 608       end if;
 609
 610       --  Remove trailing spaces
 611
 612       S := Scan_Ptr;
 613       while L > 0 and then Is_White_Space (Source (S - 1)) loop
 614          S := S - 1;
 615          L := L - 1;
 616       end loop;
 617
 618       --  Issue message for blanks at end of line if option enabled
 619
 620       if Style_Check_Blanks_At_End and then L < Len then
 621          Error_Msg
 622            ("(style) trailing spaces not permitted", S);
 623       end if;
 624
 625       --  Deal with empty (blank) line
 626
 627       if L = 0 then
 628
 629          --  Increment blank line count
 630
 631          Blank_Lines := Blank_Lines + 1;
 632
 633          --  If first blank line, record location for later error message
 634
 635          if Blank_Lines = 1 then
 636             Blank_Line_Location := Scan_Ptr;
 637          end if;
 638
 639       --  Non-blank line, check for previous multiple blank lines
 640
 641       else
 642          if Style_Check_Blank_Lines and then Blank_Lines > 1 then
 643             Error_Msg
 644               ("(style) multiple blank lines", Blank_Line_Location);
 645          end if;
 646
 647          --  And reset blank line count
 648
 649          Blank_Lines := 0;
 650       end if;
 651    end Check_Line_Terminator;
 652
 653    --------------------------
 654    -- Check_No_Space_After --
 655    --------------------------
 656
 657    procedure Check_No_Space_After is
 658       S : Source_Ptr;
 659
 660    begin
 661       if Is_White_Space (Source (Scan_Ptr)) then
 662
 663          --  Allow one or more spaces if followed by comment
 664
 665          S := Scan_Ptr + 1;
 666          loop
 667             if Source (S) = '-' and then Source (S + 1) = '-' then
 668                return;
 669
 670             elsif Is_White_Space (Source (S)) then
 671                S := S + 1;
 672
 673             else
 674                exit;
 675             end if;
 676          end loop;
 677
 678          Error_Space_Not_Allowed (Scan_Ptr);
 679       end if;
 680    end Check_No_Space_After;
 681
 682    ---------------------------
 683    -- Check_No_Space_Before --
 684    ---------------------------
 685
 686    procedure Check_No_Space_Before is
 687    begin
 688       if Token_Ptr > First_Non_Blank_Location
 689          and then Source (Token_Ptr - 1) <= ' '
 690       then
 691          Error_Space_Not_Allowed (Token_Ptr - 1);
 692       end if;
 693    end Check_No_Space_Before;
 694
 695    -----------------------
 696    -- Check_Pragma_Name --
 697    -----------------------
 698
 699    --  In check pragma casing mode (-gnatyp), pragma names must be mixed
 700    --  case, i.e. start with an upper case letter, and otherwise lower case,
 701    --  except after an underline character.
 702
 703    procedure Check_Pragma_Name is
 704    begin
 705       if Style_Check_Pragma_Casing then
 706          if Determine_Token_Casing /= Mixed_Case then
 707             Error_Msg_SC ("(style) bad capitalization, mixed case required");
 708          end if;
 709       end if;
 710    end Check_Pragma_Name;
 711
 712    -----------------------
 713    -- Check_Right_Paren --
 714    -----------------------
 715
 716    --  In check tokens mode (-gnatyt), right paren must never be preceded by
 717    --  a space unless it is the initial non-blank character on the line.
 718
 719    procedure Check_Right_Paren is
 720    begin
 721       if Style_Check_Tokens then
 722          Check_No_Space_Before;
 723       end if;
 724    end Check_Right_Paren;
 725
 726    ---------------------
 727    -- Check_Semicolon --
 728    ---------------------
 729
 730    --  In check tokens mode (-gnatyt), semicolon does not permit a preceding
 731    --  space and a following space is required.
 732
 733    procedure Check_Semicolon is
 734    begin
 735       if Style_Check_Tokens then
 736          Check_No_Space_Before;
 737
 738          if Source (Scan_Ptr) > ' ' then
 739             Error_Space_Required (Scan_Ptr);
 740          end if;
 741       end if;
 742    end Check_Semicolon;
 743
 744    -------------------------------
 745    -- Check_Separate_Stmt_Lines --
 746    -------------------------------
 747
 748    procedure Check_Separate_Stmt_Lines is
 749    begin
 750       if Style_Check_Separate_Stmt_Lines then
 751          Check_Separate_Stmt_Lines_Cont;
 752       end if;
 753    end Check_Separate_Stmt_Lines;
 754
 755    ------------------------------------
 756    -- Check_Separate_Stmt_Lines_Cont --
 757    ------------------------------------
 758
 759    procedure Check_Separate_Stmt_Lines_Cont is
 760       S : Source_Ptr;
 761
 762    begin
 763       --  Skip past white space
 764
 765       S := Scan_Ptr;
 766       while Is_White_Space (Source (S)) loop
 767          S := S + 1;
 768       end loop;
 769
 770       --  Line terminator is OK
 771
 772       if Source (S) in Line_Terminator then
 773          return;
 774
 775       --  Comment is OK
 776
 777       elsif Source (S) = '-' and then Source (S + 1) = '-' then
 778          return;
 779
 780       --  ABORT keyword is OK after THEN (THEN ABORT case)
 781
 782       elsif Token = Tok_Then
 783         and then (Source (S + 0) = 'a' or else Source (S + 0) = 'A')
 784         and then (Source (S + 1) = 'b' or else Source (S + 1) = 'B')
 785         and then (Source (S + 2) = 'o' or else Source (S + 2) = 'O')
 786         and then (Source (S + 3) = 'r' or else Source (S + 3) = 'R')
 787         and then (Source (S + 4) = 't' or else Source (S + 4) = 'T')
 788         and then (Source (S + 5) in Line_Terminator
 789                    or else Is_White_Space (Source (S + 5)))
 790       then
 791          return;
 792
 793       --  PRAGMA keyword is OK after ELSE
 794
 795       elsif Token = Tok_Else
 796         and then (Source (S + 0) = 'p' or else Source (S + 0) = 'P')
 797         and then (Source (S + 1) = 'r' or else Source (S + 1) = 'R')
 798         and then (Source (S + 2) = 'a' or else Source (S + 2) = 'A')
 799         and then (Source (S + 3) = 'g' or else Source (S + 3) = 'G')
 800         and then (Source (S + 4) = 'm' or else Source (S + 4) = 'M')
 801         and then (Source (S + 5) = 'a' or else Source (S + 5) = 'A')
 802         and then (Source (S + 6) in Line_Terminator
 803                    or else Is_White_Space (Source (S + 6)))
 804       then
 805          return;
 806
 807          --  Otherwise we have the style violation we are looking for
 808
 809       else
 810          if Token = Tok_Then then
 811             Error_Msg
 812               ("(style) no statements may follow THEN on same line", S);
 813          else
 814             Error_Msg
 815               ("(style) no statements may follow ELSE on same line", S);
 816          end if;
 817       end if;
 818    end Check_Separate_Stmt_Lines_Cont;
 819
 820    ----------------
 821    -- Check_Then --
 822    ----------------
 823
 824    --  In check if then layout mode (-gnatyi), we expect a THEN keyword
 825    --  to appear either on the same line as the IF, or on a separate line
 826    --  after multiple conditions. In any case, it may not appear on the
 827    --  line immediately following the line with the IF.
 828
 829    procedure Check_Then (If_Loc : Source_Ptr) is
 830    begin
 831       if Style_Check_If_Then_Layout then
 832          if Get_Physical_Line_Number (Token_Ptr) =
 833             Get_Physical_Line_Number (If_Loc) + 1
 834          then
 835             Error_Msg_SC ("(style) misplaced THEN");
 836          end if;
 837       end if;
 838    end Check_Then;
 839
 840    -------------------------------
 841    -- Check_Unary_Plus_Or_Minus --
 842    -------------------------------
 843
 844    --  In check tokem mode (-gnatyt), unary plus or minus must not be
 845    --  followed by a space.
 846
 847    procedure Check_Unary_Plus_Or_Minus is
 848    begin
 849       if Style_Check_Tokens then
 850          Check_No_Space_After;
 851       end if;
 852    end Check_Unary_Plus_Or_Minus;
 853
 854    ------------------------
 855    -- Check_Vertical_Bar --
 856    ------------------------
 857
 858    --  In check token mode (-gnatyt), vertical bar must be surrounded by spaces
 859
 860    procedure Check_Vertical_Bar is
 861    begin
 862       if Style_Check_Tokens then
 863          Require_Preceding_Space;
 864          Require_Following_Space;
 865       end if;
 866    end Check_Vertical_Bar;
 867
 868    -----------------------
 869    -- Check_Xtra_Parens --
 870    -----------------------
 871
 872    procedure Check_Xtra_Parens (Loc : Source_Ptr) is
 873    begin
 874       if Style_Check_Xtra_Parens then
 875          Error_Msg ("redundant parentheses?", Loc);
 876       end if;
 877    end Check_Xtra_Parens;
 878
 879    ----------------------------
 880    -- Determine_Token_Casing --
 881    ----------------------------
 882
 883    function Determine_Token_Casing return Casing_Type is
 884    begin
 885       return Determine_Casing (Source (Token_Ptr .. Scan_Ptr - 1));
 886    end Determine_Token_Casing;
 887
 888    -----------------------------
 889    -- Error_Space_Not_Allowed --
 890    -----------------------------
 891
 892    procedure Error_Space_Not_Allowed (S : Source_Ptr) is
 893    begin
 894       Error_Msg ("(style) space not allowed", S);
 895    end Error_Space_Not_Allowed;
 896
 897    --------------------------
 898    -- Error_Space_Required --
 899    --------------------------
 900
 901    procedure Error_Space_Required (S : Source_Ptr) is
 902    begin
 903       Error_Msg ("(style) space required", S);
 904    end Error_Space_Required;
 905
 906    --------------------
 907    -- Is_White_Space --
 908    --------------------
 909
 910    function Is_White_Space (C : Character) return Boolean is
 911    begin
 912       return C = ' ' or else C = HT;
 913    end Is_White_Space;
 914
 915    -------------------
 916    -- Mode_In_Check --
 917    -------------------
 918
 919    function Mode_In_Check return Boolean is
 920    begin
 921       return Style_Check and Style_Check_Mode_In;
 922    end Mode_In_Check;
 923
 924    -----------------
 925    -- No_End_Name --
 926    -----------------
 927
 928    --  In check end/exit labels mode (-gnatye), always require the name of
 929    --  a subprogram or package to be present on the END, so this is an error.
 930
 931    procedure No_End_Name (Name : Node_Id) is
 932    begin
 933       if Style_Check_End_Labels then
 934          Error_Msg_Node_1 := Name;
 935          Error_Msg_SP ("(style) `END &` required");
 936       end if;
 937    end No_End_Name;
 938
 939    ------------------
 940    -- No_Exit_Name --
 941    ------------------
 942
 943    --  In check end/exit labels mode (-gnatye), always require the name of
 944    --  the loop to be present on the EXIT when exiting a named loop.
 945
 946    procedure No_Exit_Name (Name : Node_Id) is
 947    begin
 948       if Style_Check_End_Labels then
 949          Error_Msg_Node_1 := Name;
 950          Error_Msg_SP ("(style) `EXIT &` required");
 951       end if;
 952    end No_Exit_Name;
 953
 954    ----------------------------
 955    -- Non_Lower_Case_Keyword --
 956    ----------------------------
 957
 958    --  In check casing mode (-gnatyk), reserved keywords must be be spelled
 959    --  in all lower case (excluding keywords range, access, delta and digits
 960    --  used as attribute designators).
 961
 962    procedure Non_Lower_Case_Keyword is
 963    begin
 964       if Style_Check_Keyword_Casing then
 965          Error_Msg_SC ("(style) reserved words must be all lower case");
 966       end if;
 967    end Non_Lower_Case_Keyword;
 968
 969    -----------------------------
 970    -- Require_Following_Space --
 971    -----------------------------
 972
 973    procedure Require_Following_Space is
 974    begin
 975       if Source (Scan_Ptr) > ' ' then
 976          Error_Space_Required (Scan_Ptr);
 977       end if;
 978    end Require_Following_Space;
 979
 980    -----------------------------
 981    -- Require_Preceding_Space --
 982    -----------------------------
 983
 984    procedure Require_Preceding_Space is
 985    begin
 986       if Token_Ptr > Source_First (Current_Source_File)
 987         and then Source (Token_Ptr - 1) > ' '
 988       then
 989          Error_Space_Required (Token_Ptr);
 990       end if;
 991    end Require_Preceding_Space;
 992
 993    ---------------------
 994    -- RM_Column_Check --
 995    ---------------------
 996
 997    function RM_Column_Check return Boolean is
 998    begin
 999       return Style_Check and Style_Check_Layout;
1000    end RM_Column_Check;
1001
1002 end Styleg;