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    procedure Check_Comment is
 265       S : Source_Ptr;
 266       C : Character;
 267
 268       function Is_Box_Comment return Boolean;
 269       --  Returns True if the last two characters on the line are -- which
 270       --  characterizes a box comment (as for example follows this spec).
 271
 272       --------------------
 273       -- Is_Box_Comment --
 274       --------------------
 275
 276       function Is_Box_Comment return Boolean is
 277          S : Source_Ptr;
 278
 279       begin
 280          --  Do we need to worry about UTF_32 line terminators here ???
 281
 282          S := Scan_Ptr + 3;
 283          while Source (S) not in Line_Terminator loop
 284             S := S + 1;
 285          end loop;
 286
 287          return Source (S - 1) = '-' and then Source (S - 2) = '-';
 288       end Is_Box_Comment;
 289
 290    --  Start of processing for Check_Comment
 291
 292    begin
 293       --  Can never have a non-blank character preceding the first minus
 294
 295       if Style_Check_Comments then
 296          if Scan_Ptr > Source_First (Current_Source_File)
 297            and then Source (Scan_Ptr - 1) > ' '
 298          then
 299             Error_Msg_S ("(style) space required");
 300          end if;
 301       end if;
 302
 303       --  For a comment that is not at the start of the line, the only
 304       --  requirement is that we cannot have a non-blank character after
 305       --  the second minus sign.
 306
 307       if Scan_Ptr /= First_Non_Blank_Location then
 308          if Style_Check_Comments then
 309             if Source (Scan_Ptr + 2) > ' ' then
 310                Error_Msg ("(style) space required", Scan_Ptr + 2);
 311             end if;
 312          end if;
 313
 314          return;
 315
 316       --  Case of a comment that is at the start of a line
 317
 318       else
 319          --  First check, must be in appropriately indented column
 320
 321          if Style_Check_Indentation /= 0 then
 322             if Start_Column rem Style_Check_Indentation /= 0 then
 323                Error_Msg_S ("(style) bad column");
 324                return;
 325             end if;
 326          end if;
 327
 328          --  If we are not checking comments, nothing to do
 329
 330          if not Style_Check_Comments then
 331             return;
 332          end if;
 333
 334          --  Case of not followed by a blank. Usually wrong, but there are
 335          --  some exceptions that we permit.
 336
 337          if Source (Scan_Ptr + 2) /= ' ' then
 338             C := Source (Scan_Ptr + 2);
 339
 340             --  Case of -- all on its own on a line is OK
 341
 342             if C < ' ' then
 343                return;
 344             end if;
 345
 346             --  Case of --x, x special character is OK (gnatprep/SPARK/etc.)
 347             --  This is not permitted in internal GNAT implementation units
 348             --  except for the case of --! as used by gnatprep output.
 349
 350             if GNAT_Mode then
 351                if C = '!' then
 352                   return;
 353                end if;
 354
 355             else
 356                if Character'Pos (C) in 16#21# .. 16#2F#
 357                     or else
 358                   Character'Pos (C) in 16#3A# .. 16#3F#
 359                then
 360                   return;
 361                end if;
 362             end if;
 363
 364             --  The only other case in which we allow a character after
 365             --  the -- other than a space is when we have a row of minus
 366             --  signs (case of header lines for a box comment for example).
 367
 368             S := Scan_Ptr + 2;
 369             while Source (S) >= ' ' loop
 370                if Source (S) /= '-' then
 371                   if Is_Box_Comment then
 372                      Error_Space_Required (Scan_Ptr + 2);
 373                   else
 374                      Error_Msg ("(style) two spaces required", Scan_Ptr + 2);
 375                   end if;
 376
 377                   return;
 378                end if;
 379
 380                S := S + 1;
 381             end loop;
 382
 383          --  If we are followed by a blank, then the comment is OK if the
 384          --  character following this blank is another blank or a format
 385          --  effector.
 386
 387          elsif Source (Scan_Ptr + 3) <= ' ' then
 388             return;
 389
 390          --  Here is the case where we only have one blank after the two
 391          --  minus signs, which is an error unless the line ends with two
 392          --  minus signs, the case of a box comment.
 393
 394          elsif not Is_Box_Comment then
 395             Error_Space_Required (Scan_Ptr + 3);
 396          end if;
 397       end if;
 398    end Check_Comment;
 399
 400    -------------------
 401    -- Check_Dot_Dot --
 402    -------------------
 403
 404    --  In check token mode (-gnatyt), colon must be surrounded by spaces
 405
 406    procedure Check_Dot_Dot is
 407    begin
 408       if Style_Check_Tokens then
 409          Require_Preceding_Space;
 410          Require_Following_Space;
 411       end if;
 412    end Check_Dot_Dot;
 413
 414    ---------------
 415    -- Check_EOF --
 416    ---------------
 417
 418    --  In check blanks at end mode, check no blank lines precede the EOF
 419
 420    procedure Check_EOF is
 421    begin
 422       if Style_Check_Blank_Lines then
 423
 424          --  We expect one blank line, from the EOF, but no more than one
 425
 426          if Blank_Lines = 2 then
 427             Error_Msg
 428               ("(style) blank line not allowed at end of file",
 429                Blank_Line_Location);
 430
 431          elsif Blank_Lines >= 3 then
 432             Error_Msg
 433               ("(style) blank lines not allowed at end of file",
 434                Blank_Line_Location);
 435          end if;
 436       end if;
 437    end Check_EOF;
 438
 439    -----------------------------------
 440    -- Check_Exponentiation_Operator --
 441    -----------------------------------
 442
 443    --  No spaces are required for the ** operator in GNAT style check mode
 444
 445    procedure Check_Exponentiation_Operator is
 446    begin
 447       null;
 448    end Check_Exponentiation_Operator;
 449
 450    --------------
 451    -- Check_HT --
 452    --------------
 453
 454    --  In check horizontal tab mode (-gnatyh), tab characters are not allowed
 455
 456    procedure Check_HT is
 457    begin
 458       if Style_Check_Horizontal_Tabs then
 459          Error_Msg_S ("(style) horizontal tab not allowed");
 460       end if;
 461    end Check_HT;
 462
 463    -----------------------
 464    -- Check_Indentation --
 465    -----------------------
 466
 467    --  In check indentation mode (-gnatyn for n a digit), a new statement or
 468    --  declaration is required to start in a column that is a multiple of the
 469    --  indentiation amount.
 470
 471    procedure Check_Indentation is
 472    begin
 473       if Style_Check_Indentation /= 0 then
 474          if Token_Ptr = First_Non_Blank_Location
 475            and then Start_Column rem Style_Check_Indentation /= 0
 476          then
 477             Error_Msg_SC ("(style) bad indentation");
 478          end if;
 479       end if;
 480    end Check_Indentation;
 481
 482    ----------------------
 483    -- Check_Left_Paren --
 484    ----------------------
 485
 486    --  In tone check mode (-gnatyt), left paren must not be preceded by an
 487    --  identifier character or digit (a separating space is required) and
 488    --  may never be followed by a space.
 489
 490    procedure Check_Left_Paren is
 491    begin
 492       if Style_Check_Tokens then
 493          if Token_Ptr > Source_First (Current_Source_File)
 494            and then Identifier_Char (Source (Token_Ptr - 1))
 495          then
 496             Error_Space_Required (Token_Ptr);
 497          end if;
 498
 499          Check_No_Space_After;
 500       end if;
 501    end Check_Left_Paren;
 502
 503    ---------------------------
 504    -- Check_Line_Max_Length --
 505    ---------------------------
 506
 507    --  In check max line length mode (-gnatym), the line length must
 508    --  not exceed the permitted maximum value.
 509
 510    procedure Check_Line_Max_Length (Len : Int) is
 511    begin
 512       if Style_Check_Max_Line_Length then
 513          if Len > Style_Max_Line_Length then
 514             Error_Msg
 515               ("(style) this line is too long",
 516                Current_Line_Start + Source_Ptr (Style_Max_Line_Length));
 517          end if;
 518       end if;
 519    end Check_Line_Max_Length;
 520
 521    ---------------------------
 522    -- Check_Line_Terminator --
 523    ---------------------------
 524
 525    --  In check blanks at end mode (-gnatyb), lines may not end with a
 526    --  trailing space.
 527
 528    --  In check form feeds mode (-gnatyf), the line terminator may not
 529    --  be either of the characters FF or VT.
 530
 531    --  In check DOS line terminators node (-gnatyd), the line terminator
 532    --  must be a single LF, without a following CR.
 533
 534    procedure Check_Line_Terminator (Len : Int) is
 535       S : Source_Ptr;
 536
 537       L : Int := Len;
 538       --  Length of line (adjusted down for blanks at end of line)
 539
 540    begin
 541       --  Reset count of blank lines if first line
 542
 543       if Get_Logical_Line_Number (Scan_Ptr) = 1 then
 544          Blank_Lines := 0;
 545       end if;
 546
 547       --  Check FF/VT terminators
 548
 549       if Style_Check_Form_Feeds then
 550          if Source (Scan_Ptr) = ASCII.FF then
 551             Error_Msg_S ("(style) form feed not allowed");
 552          elsif Source (Scan_Ptr) = ASCII.VT then
 553             Error_Msg_S ("(style) vertical tab not allowed");
 554          end if;
 555       end if;
 556
 557       --  Check DOS line terminator (ignore EOF, since we only get called
 558       --  with an EOF if it is the last character in the buffer, and was
 559       --  therefore not present in the sources
 560
 561       if Style_Check_DOS_Line_Terminator then
 562          if Source (Scan_Ptr) = EOF then
 563             null;
 564          elsif Source (Scan_Ptr) /= LF
 565            or else Source (Scan_Ptr + 1) = CR
 566          then
 567             Error_Msg_S ("(style) incorrect line terminator");
 568          end if;
 569       end if;
 570
 571       --  Remove trailing spaces
 572
 573       S := Scan_Ptr;
 574       while L > 0 and then Is_White_Space (Source (S - 1)) loop
 575          S := S - 1;
 576          L := L - 1;
 577       end loop;
 578
 579       --  Issue message for blanks at end of line if option enabled
 580
 581       if Style_Check_Blanks_At_End and then L < Len then
 582          Error_Msg
 583            ("(style) trailing spaces not permitted", S);
 584       end if;
 585
 586       --  Deal with empty (blank) line
 587
 588       if L = 0 then
 589
 590          --  Increment blank line count
 591
 592          Blank_Lines := Blank_Lines + 1;
 593
 594          --  If first blank line, record location for later error message
 595
 596          if Blank_Lines = 1 then
 597             Blank_Line_Location := Scan_Ptr;
 598          end if;
 599
 600       --  Non-blank line, check for previous multiple blank lines
 601
 602       else
 603          if Style_Check_Blank_Lines and then Blank_Lines > 1 then
 604             Error_Msg
 605               ("(style) multiple blank lines", Blank_Line_Location);
 606          end if;
 607
 608          --  And reset blank line count
 609
 610          Blank_Lines := 0;
 611       end if;
 612    end Check_Line_Terminator;
 613
 614    --------------------------
 615    -- Check_No_Space_After --
 616    --------------------------
 617
 618    procedure Check_No_Space_After is
 619       S : Source_Ptr;
 620
 621    begin
 622       if Is_White_Space (Source (Scan_Ptr)) then
 623
 624          --  Allow one or more spaces if followed by comment
 625
 626          S := Scan_Ptr + 1;
 627          loop
 628             if Source (S) = '-' and then Source (S + 1) = '-' then
 629                return;
 630
 631             elsif Is_White_Space (Source (S)) then
 632                S := S + 1;
 633
 634             else
 635                exit;
 636             end if;
 637          end loop;
 638
 639          Error_Space_Not_Allowed (Scan_Ptr);
 640       end if;
 641    end Check_No_Space_After;
 642
 643    ---------------------------
 644    -- Check_No_Space_Before --
 645    ---------------------------
 646
 647    procedure Check_No_Space_Before is
 648    begin
 649       if Token_Ptr > First_Non_Blank_Location
 650          and then Source (Token_Ptr - 1) <= ' '
 651       then
 652          Error_Space_Not_Allowed (Token_Ptr - 1);
 653       end if;
 654    end Check_No_Space_Before;
 655
 656    -----------------------
 657    -- Check_Pragma_Name --
 658    -----------------------
 659
 660    --  In check pragma casing mode (-gnatyp), pragma names must be mixed
 661    --  case, i.e. start with an upper case letter, and otherwise lower case,
 662    --  except after an underline character.
 663
 664    procedure Check_Pragma_Name is
 665    begin
 666       if Style_Check_Pragma_Casing then
 667          if Determine_Token_Casing /= Mixed_Case then
 668             Error_Msg_SC ("(style) bad capitalization, mixed case required");
 669          end if;
 670       end if;
 671    end Check_Pragma_Name;
 672
 673    -----------------------
 674    -- Check_Right_Paren --
 675    -----------------------
 676
 677    --  In check tokens mode (-gnatyt), right paren must never be preceded by
 678    --  a space unless it is the initial non-blank character on the line.
 679
 680    procedure Check_Right_Paren is
 681    begin
 682       if Style_Check_Tokens then
 683          Check_No_Space_Before;
 684       end if;
 685    end Check_Right_Paren;
 686
 687    ---------------------
 688    -- Check_Semicolon --
 689    ---------------------
 690
 691    --  In check tokens mode (-gnatyt), semicolon does not permit a preceding
 692    --  space and a following space is required.
 693
 694    procedure Check_Semicolon is
 695    begin
 696       if Style_Check_Tokens then
 697          Check_No_Space_Before;
 698
 699          if Source (Scan_Ptr) > ' ' then
 700             Error_Space_Required (Scan_Ptr);
 701          end if;
 702       end if;
 703    end Check_Semicolon;
 704
 705    -------------------------------
 706    -- Check_Separate_Stmt_Lines --
 707    -------------------------------
 708
 709    procedure Check_Separate_Stmt_Lines is
 710    begin
 711       if Style_Check_Separate_Stmt_Lines then
 712          Check_Separate_Stmt_Lines_Cont;
 713       end if;
 714    end Check_Separate_Stmt_Lines;
 715
 716    ------------------------------------
 717    -- Check_Separate_Stmt_Lines_Cont --
 718    ------------------------------------
 719
 720    procedure Check_Separate_Stmt_Lines_Cont is
 721       S : Source_Ptr;
 722
 723    begin
 724       --  Skip past white space
 725
 726       S := Scan_Ptr;
 727       while Is_White_Space (Source (S)) loop
 728          S := S + 1;
 729       end loop;
 730
 731       --  Line terminator is OK
 732
 733       if Source (S) in Line_Terminator then
 734          return;
 735
 736       --  Comment is OK
 737
 738       elsif Source (S) = '-' and then Source (S + 1) = '-' then
 739          return;
 740
 741       --  ABORT keyword is OK after THEN (THEN ABORT case)
 742
 743       elsif Token = Tok_Then
 744         and then (Source (S + 0) = 'a' or else Source (S + 0) = 'A')
 745         and then (Source (S + 1) = 'b' or else Source (S + 1) = 'B')
 746         and then (Source (S + 2) = 'o' or else Source (S + 2) = 'O')
 747         and then (Source (S + 3) = 'r' or else Source (S + 3) = 'R')
 748         and then (Source (S + 4) = 't' or else Source (S + 4) = 'T')
 749         and then (Source (S + 5) in Line_Terminator
 750                    or else Is_White_Space (Source (S + 5)))
 751       then
 752          return;
 753
 754       --  PRAGMA keyword is OK after ELSE
 755
 756       elsif Token = Tok_Else
 757         and then (Source (S + 0) = 'p' or else Source (S + 0) = 'P')
 758         and then (Source (S + 1) = 'r' or else Source (S + 1) = 'R')
 759         and then (Source (S + 2) = 'a' or else Source (S + 2) = 'A')
 760         and then (Source (S + 3) = 'g' or else Source (S + 3) = 'G')
 761         and then (Source (S + 4) = 'm' or else Source (S + 4) = 'M')
 762         and then (Source (S + 5) = 'a' or else Source (S + 5) = 'A')
 763         and then (Source (S + 6) in Line_Terminator
 764                    or else Is_White_Space (Source (S + 6)))
 765       then
 766          return;
 767
 768          --  Otherwise we have the style violation we are looking for
 769
 770       else
 771          if Token = Tok_Then then
 772             Error_Msg
 773               ("(style) no statements may follow THEN on same line", S);
 774          else
 775             Error_Msg
 776               ("(style) no statements may follow ELSE on same line", S);
 777          end if;
 778       end if;
 779    end Check_Separate_Stmt_Lines_Cont;
 780
 781    ----------------
 782    -- Check_Then --
 783    ----------------
 784
 785    --  In check if then layout mode (-gnatyi), we expect a THEN keyword
 786    --  to appear either on the same line as the IF, or on a separate line
 787    --  after multiple conditions. In any case, it may not appear on the
 788    --  line immediately following the line with the IF.
 789
 790    procedure Check_Then (If_Loc : Source_Ptr) is
 791    begin
 792       if Style_Check_If_Then_Layout then
 793          if Get_Physical_Line_Number (Token_Ptr) =
 794             Get_Physical_Line_Number (If_Loc) + 1
 795          then
 796             Error_Msg_SC ("(style) misplaced THEN");
 797          end if;
 798       end if;
 799    end Check_Then;
 800
 801    -------------------------------
 802    -- Check_Unary_Plus_Or_Minus --
 803    -------------------------------
 804
 805    --  In check tokem mode (-gnatyt), unary plus or minus must not be
 806    --  followed by a space.
 807
 808    procedure Check_Unary_Plus_Or_Minus is
 809    begin
 810       if Style_Check_Tokens then
 811          Check_No_Space_After;
 812       end if;
 813    end Check_Unary_Plus_Or_Minus;
 814
 815    ------------------------
 816    -- Check_Vertical_Bar --
 817    ------------------------
 818
 819    --  In check token mode (-gnatyt), vertical bar must be surrounded by spaces
 820
 821    procedure Check_Vertical_Bar is
 822    begin
 823       if Style_Check_Tokens then
 824          Require_Preceding_Space;
 825          Require_Following_Space;
 826       end if;
 827    end Check_Vertical_Bar;
 828
 829    -----------------------
 830    -- Check_Xtra_Parens --
 831    -----------------------
 832
 833    procedure Check_Xtra_Parens (Loc : Source_Ptr) is
 834    begin
 835       if Style_Check_Xtra_Parens then
 836          Error_Msg ("redundant parentheses?", Loc);
 837       end if;
 838    end Check_Xtra_Parens;
 839
 840    ----------------------------
 841    -- Determine_Token_Casing --
 842    ----------------------------
 843
 844    function Determine_Token_Casing return Casing_Type is
 845    begin
 846       return Determine_Casing (Source (Token_Ptr .. Scan_Ptr - 1));
 847    end Determine_Token_Casing;
 848
 849    -----------------------------
 850    -- Error_Space_Not_Allowed --
 851    -----------------------------
 852
 853    procedure Error_Space_Not_Allowed (S : Source_Ptr) is
 854    begin
 855       Error_Msg ("(style) space not allowed", S);
 856    end Error_Space_Not_Allowed;
 857
 858    --------------------------
 859    -- Error_Space_Required --
 860    --------------------------
 861
 862    procedure Error_Space_Required (S : Source_Ptr) is
 863    begin
 864       Error_Msg ("(style) space required", S);
 865    end Error_Space_Required;
 866
 867    --------------------
 868    -- Is_White_Space --
 869    --------------------
 870
 871    function Is_White_Space (C : Character) return Boolean is
 872    begin
 873       return C = ' ' or else C = HT;
 874    end Is_White_Space;
 875
 876    -------------------
 877    -- Mode_In_Check --
 878    -------------------
 879
 880    function Mode_In_Check return Boolean is
 881    begin
 882       return Style_Check and Style_Check_Mode_In;
 883    end Mode_In_Check;
 884
 885    -----------------
 886    -- No_End_Name --
 887    -----------------
 888
 889    --  In check end/exit labels mode (-gnatye), always require the name of
 890    --  a subprogram or package to be present on the END, so this is an error.
 891
 892    procedure No_End_Name (Name : Node_Id) is
 893    begin
 894       if Style_Check_End_Labels then
 895          Error_Msg_Node_1 := Name;
 896          Error_Msg_SP ("(style) `END &` required");
 897       end if;
 898    end No_End_Name;
 899
 900    ------------------
 901    -- No_Exit_Name --
 902    ------------------
 903
 904    --  In check end/exit labels mode (-gnatye), always require the name of
 905    --  the loop to be present on the EXIT when exiting a named loop.
 906
 907    procedure No_Exit_Name (Name : Node_Id) is
 908    begin
 909       if Style_Check_End_Labels then
 910          Error_Msg_Node_1 := Name;
 911          Error_Msg_SP ("(style) `EXIT &` required");
 912       end if;
 913    end No_Exit_Name;
 914
 915    ----------------------------
 916    -- Non_Lower_Case_Keyword --
 917    ----------------------------
 918
 919    --  In check casing mode (-gnatyk), reserved keywords must be be spelled
 920    --  in all lower case (excluding keywords range, access, delta and digits
 921    --  used as attribute designators).
 922
 923    procedure Non_Lower_Case_Keyword is
 924    begin
 925       if Style_Check_Keyword_Casing then
 926          Error_Msg_SC ("(style) reserved words must be all lower case");
 927       end if;
 928    end Non_Lower_Case_Keyword;
 929
 930    -----------------------------
 931    -- Require_Following_Space --
 932    -----------------------------
 933
 934    procedure Require_Following_Space is
 935    begin
 936       if Source (Scan_Ptr) > ' ' then
 937          Error_Space_Required (Scan_Ptr);
 938       end if;
 939    end Require_Following_Space;
 940
 941    -----------------------------
 942    -- Require_Preceding_Space --
 943    -----------------------------
 944
 945    procedure Require_Preceding_Space is
 946    begin
 947       if Token_Ptr > Source_First (Current_Source_File)
 948         and then Source (Token_Ptr - 1) > ' '
 949       then
 950          Error_Space_Required (Token_Ptr);
 951       end if;
 952    end Require_Preceding_Space;
 953
 954    ---------------------
 955    -- RM_Column_Check --
 956    ---------------------
 957
 958    function RM_Column_Check return Boolean is
 959    begin
 960       return Style_Check and Style_Check_Layout;
 961    end RM_Column_Check;
 962
 963 end Styleg;