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