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