gcc/ada/style.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                S T Y L E                                 --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision$
  10 --                                                                          --
  11 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 --  This version of the Style package implements the standard GNAT style
  30 --  checking rules. For documentation of these rules, see comments on the
  31 --  individual procedures.
  32
  33 with Atree;    use Atree;
  34 with Casing;   use Casing;
  35 with Csets;    use Csets;
  36 with Einfo;    use Einfo;
  37 with Errout;   use Errout;
  38 with Namet;    use Namet;
  39 with Opt;      use Opt;
  40 with Scn;      use Scn;
  41 with Scans;    use Scans;
  42 with Sinfo;    use Sinfo;
  43 with Sinput;   use Sinput;
  44 with Stand;    use Stand;
  45 with Stylesw;  use Stylesw;
  46
  47 package body Style is
  48
  49    -----------------------
  50    -- Local Subprograms --
  51    -----------------------
  52
  53    procedure Error_Space_Not_Allowed (S : Source_Ptr);
  54    --  Posts an error message indicating that a space is not allowed
  55    --  at the given source location.
  56
  57    procedure Error_Space_Required (S : Source_Ptr);
  58    --  Posts an error message indicating that a space is required at
  59    --  the given source location.
  60
  61    procedure Require_Following_Space;
  62    pragma Inline (Require_Following_Space);
  63    --  Require token to be followed by white space. Used only if in GNAT
  64    --  style checking mode.
  65
  66    procedure Require_Preceding_Space;
  67    pragma Inline (Require_Preceding_Space);
  68    --  Require token to be preceded by white space. Used only if in GNAT
  69    --  style checking mode.
  70
  71    -----------------------
  72    -- Body_With_No_Spec --
  73    -----------------------
  74
  75    --  If the check specs mode (-gnatys) is set, then all subprograms must
  76    --  have specs unless they are parameterless procedures that are not child
  77    --  units at the library level (i.e. they are possible main programs).
  78
  79    procedure Body_With_No_Spec (N : Node_Id) is
  80    begin
  81       if Style_Check_Specs then
  82          if Nkind (Parent (N)) = N_Compilation_Unit then
  83             declare
  84                Spec  : constant Node_Id := Specification (N);
  85                Defnm : constant Node_Id := Defining_Unit_Name (Spec);
  86
  87             begin
  88                if Nkind (Spec) = N_Procedure_Specification
  89                  and then Nkind (Defnm) = N_Defining_Identifier
  90                  and then No (First_Formal (Defnm))
  91                then
  92                   return;
  93                end if;
  94             end;
  95          end if;
  96
  97          Error_Msg_N ("(style): subprogram body has no previous spec", N);
  98       end if;
  99    end Body_With_No_Spec;
 100
 101    ----------------------
 102    -- Check_Abs_Or_Not --
 103    ----------------------
 104
 105    --  In check tokens mode (-gnatyt), ABS/NOT must be followed by a space
 106
 107    procedure Check_Abs_Not is
 108    begin
 109       if Style_Check_Tokens then
 110          if Source (Scan_Ptr) > ' ' then
 111             Error_Space_Required (Scan_Ptr);
 112          end if;
 113       end if;
 114    end Check_Abs_Not;
 115
 116    -----------------
 117    -- Check_Arrow --
 118    -----------------
 119
 120    --  In check tokens mode (-gnatys), arrow must be surrounded by spaces
 121
 122    procedure Check_Arrow is
 123    begin
 124       if Style_Check_Tokens then
 125          Require_Preceding_Space;
 126          Require_Following_Space;
 127       end if;
 128    end Check_Arrow;
 129
 130    --------------------------
 131    -- Check_Attribute_Name --
 132    --------------------------
 133
 134    --  In check attribute casing mode (-gnatya), attribute names must be
 135    --  mixed case, i.e. start with an upper case letter, and otherwise
 136    --  lower case, except after an underline character.
 137
 138    procedure Check_Attribute_Name (Reserved : Boolean) is
 139    begin
 140       if Style_Check_Attribute_Casing then
 141          if Determine_Token_Casing /= Mixed_Case then
 142             Error_Msg_SC ("(style) bad capitalization, mixed case required");
 143          end if;
 144       end if;
 145    end Check_Attribute_Name;
 146
 147    ---------------------------
 148    -- Check_Binary_Operator --
 149    ---------------------------
 150
 151    --  In check token mode (-gnatyt), binary operators other than the special
 152    --  case of exponentiation require surrounding space characters.
 153
 154    procedure Check_Binary_Operator is
 155    begin
 156       if Style_Check_Tokens then
 157          Require_Preceding_Space;
 158          Require_Following_Space;
 159       end if;
 160    end Check_Binary_Operator;
 161
 162    ---------------
 163    -- Check_Box --
 164    ---------------
 165
 166    --  In check token mode (-gnatyt), box must be preceded by a space or by
 167    --  a left parenthesis. Spacing checking on the surrounding tokens takes
 168    --  care of the remaining checks.
 169
 170    procedure Check_Box is
 171    begin
 172       if Style_Check_Tokens then
 173          if Prev_Token /= Tok_Left_Paren then
 174             Require_Preceding_Space;
 175          end if;
 176       end if;
 177    end Check_Box;
 178
 179    -----------------
 180    -- Check_Colon --
 181    -----------------
 182
 183    --  In check token mode (-gnatyt), colon must be surrounded by spaces
 184
 185    procedure Check_Colon is
 186    begin
 187       if Style_Check_Tokens then
 188          Require_Preceding_Space;
 189          Require_Following_Space;
 190       end if;
 191    end Check_Colon;
 192
 193    -----------------------
 194    -- Check_Colon_Equal --
 195    -----------------------
 196
 197    --  In check token mode (-gnatyt), := must be surrounded by spaces
 198
 199    procedure Check_Colon_Equal is
 200    begin
 201       if Style_Check_Tokens then
 202          Require_Preceding_Space;
 203          Require_Following_Space;
 204       end if;
 205    end Check_Colon_Equal;
 206
 207    -----------------
 208    -- Check_Comma --
 209    -----------------
 210
 211    --  In check token mode (-gnatyt), comma must be either the first
 212    --  token on a line, or be preceded by a non-blank character.
 213    --  It must also always be followed by a blank.
 214
 215    procedure Check_Comma is
 216    begin
 217       if Style_Check_Tokens then
 218          if Token_Ptr > First_Non_Blank_Location
 219            and then Source (Token_Ptr - 1) = ' '
 220          then
 221             Error_Space_Not_Allowed (Token_Ptr - 1);
 222          end if;
 223
 224          if Source (Scan_Ptr) > ' ' then
 225             Error_Space_Required (Scan_Ptr);
 226          end if;
 227       end if;
 228    end Check_Comma;
 229
 230    -------------------
 231    -- Check_Comment --
 232    -------------------
 233
 234    --  In check comment mode (-gnatyc) there are several requirements on the
 235    --  format of comments. The following are permissible comment formats:
 236
 237    --    1. Any comment that is not at the start of a line, i.e. where the
 238    --       initial minuses are not the first non-blank characters on the
 239    --       line must have at least one blank after the second minus.
 240
 241    --    2. A row of all minuses of any length is permitted (see procedure
 242    --       box above in the source of this routine).
 243
 244    --    3. A comment line starting with two minuses and a space, and ending
 245    --       with a space and two minuses. Again see the procedure title box
 246    --       immediately above in the source.
 247
 248    --    4. A full line comment where two spaces follow the two minus signs.
 249    --       This is the normal comment format in GNAT style, as typified by
 250    --       the comments you are reading now.
 251
 252    --    5. A full line comment where the first character after the second
 253    --       minus is a special character, i.e. a character in the ASCII
 254    --       range 16#21#..16#2F# or 16#3A#..16#3F#. This allows special
 255    --       comments, such as those generated by gnatprep, or those that
 256    --       appear in the SPARK annotation language to be accepted.
 257
 258    procedure Check_Comment is
 259       S : Source_Ptr;
 260       C : Character;
 261
 262    begin
 263       --  Can never have a non-blank character preceding the first minus
 264
 265       if Style_Check_Comments then
 266          if Scan_Ptr > Source_First (Current_Source_File)
 267            and then Source (Scan_Ptr - 1) > ' '
 268          then
 269             Error_Msg_S ("(style) space required");
 270          end if;
 271       end if;
 272
 273       --  For a comment that is not at the start of the line, the only
 274       --  requirement is that we cannot have a non-blank character after
 275       --  the second minus sign.
 276
 277       if Scan_Ptr /= First_Non_Blank_Location then
 278          if Style_Check_Comments then
 279             if Source (Scan_Ptr + 2) > ' ' then
 280                Error_Msg ("(style) space required", Scan_Ptr + 2);
 281             end if;
 282          end if;
 283
 284          return;
 285
 286       --  Case of a comment that is at the start of a line
 287
 288       else
 289          --  First check, must be in appropriately indented column
 290
 291          if Style_Check_Indentation /= 0 then
 292             if Start_Column rem Style_Check_Indentation /= 0 then
 293                Error_Msg_S ("(style) bad column");
 294                return;
 295             end if;
 296          end if;
 297
 298          --  Now check form of the comment
 299
 300          if not Style_Check_Comments then
 301             return;
 302
 303          --  Case of not followed by a blank. Usually wrong, but there are
 304          --  some exceptions that we permit.
 305
 306          elsif Source (Scan_Ptr + 2) /= ' ' then
 307             C := Source (Scan_Ptr + 2);
 308
 309             --  Case of -- all on its own on a line is OK
 310
 311             if C < ' ' then
 312                return;
 313
 314             --  Case of --x, x special character is OK (gnatprep/SPARK/etc.)
 315
 316             elsif Character'Pos (C) in 16#21# .. 16#2F#
 317                     or else
 318                   Character'Pos (C) in 16#3A# .. 16#3F#
 319             then
 320                return;
 321
 322             --  Otherwise only cases allowed are when the entire line is
 323             --  made up of minus signs (case of a box comment).
 324
 325             else
 326                S := Scan_Ptr + 2;
 327
 328                while Source (S) >= ' ' loop
 329                   if Source (S) /= '-' then
 330                      Error_Space_Required (Scan_Ptr + 2);
 331                      return;
 332                   end if;
 333
 334                   S := S + 1;
 335                end loop;
 336             end if;
 337
 338          --  If we are followed by a blank, then the comment is OK if the
 339          --  character following this blank is another blank or a format
 340          --  effector.
 341
 342          elsif Source (Scan_Ptr + 3) <= ' ' then
 343             return;
 344
 345          --  Here is the case where we only have one blank after the two minus
 346          --  signs, which is an error unless the line ends with two blanks, the
 347          --  case of a box comment.
 348
 349          else
 350             S := Scan_Ptr + 3;
 351
 352             while Source (S) not in Line_Terminator loop
 353                S := S + 1;
 354             end loop;
 355
 356             if Source (S - 1) /= '-' or else Source (S - 2) /= '-' then
 357                Error_Space_Required (Scan_Ptr + 3);
 358             end if;
 359          end if;
 360       end if;
 361    end Check_Comment;
 362
 363    -------------------
 364    -- Check_Dot_Dot --
 365    -------------------
 366
 367    --  In check token mode (-gnatyt), colon must be surrounded by spaces
 368
 369    procedure Check_Dot_Dot is
 370    begin
 371       if Style_Check_Tokens then
 372          Require_Preceding_Space;
 373          Require_Following_Space;
 374       end if;
 375    end Check_Dot_Dot;
 376
 377    -----------------------------------
 378    -- Check_Exponentiation_Operator --
 379    -----------------------------------
 380
 381    --  No spaces are required for the ** operator in GNAT style check mode
 382
 383    procedure Check_Exponentiation_Operator is
 384    begin
 385       null;
 386    end Check_Exponentiation_Operator;
 387
 388    --------------
 389    -- Check_HT --
 390    --------------
 391
 392    --  In check horizontal tab mode (-gnatyh), tab characters are not allowed
 393
 394    procedure Check_HT is
 395    begin
 396       if Style_Check_Horizontal_Tabs then
 397          Error_Msg_S ("(style) horizontal tab not allowed");
 398       end if;
 399    end Check_HT;
 400
 401    ----------------------
 402    -- Check_Identifier --
 403    ----------------------
 404
 405    --  In check references mode (-gnatyr), identifier uses must be cased
 406    --  the same way as the corresponding identifier declaration.
 407
 408    procedure Check_Identifier
 409      (Ref : Node_Or_Entity_Id;
 410       Def : Node_Or_Entity_Id)
 411    is
 412       Sref : Source_Ptr := Sloc (Ref);
 413       Sdef : Source_Ptr := Sloc (Def);
 414       Tref : Source_Buffer_Ptr;
 415       Tdef : Source_Buffer_Ptr;
 416       Nlen : Nat;
 417       Cas  : Casing_Type;
 418
 419    begin
 420       --  If reference does not come from source, nothing to check
 421
 422       if not Comes_From_Source (Ref) then
 423          return;
 424
 425       --  Case of definition comes from source
 426
 427       elsif Comes_From_Source (Def) then
 428
 429          --  Check same casing if we are checking references
 430
 431          if Style_Check_References then
 432             Tref := Source_Text (Get_Source_File_Index (Sref));
 433             Tdef := Source_Text (Get_Source_File_Index (Sdef));
 434
 435             --  Ignore operator name case completely. This also catches the
 436             --  case of where one is an operator and the other is not. This
 437             --  is a phenomenon from rewriting of operators as functions,
 438             --  and is to be ignored.
 439
 440             if Tref (Sref) = '"' or else Tdef (Sdef) = '"' then
 441                return;
 442
 443             else
 444                while Tref (Sref) = Tdef (Sdef) loop
 445
 446                   --  If end of identifier, all done
 447
 448                   if not Identifier_Char (Tref (Sref)) then
 449                      return;
 450
 451                   --  Otherwise loop continues
 452
 453                   else
 454                      Sref := Sref + 1;
 455                      Sdef := Sdef + 1;
 456                   end if;
 457                end loop;
 458
 459                --  Fall through loop when mismatch between identifiers
 460                --  If either identifier is not terminated, error.
 461
 462                if Identifier_Char (Tref (Sref))
 463                     or else
 464                   Identifier_Char (Tdef (Sdef))
 465                then
 466                   Error_Msg_Node_1 := Def;
 467                   Error_Msg_Sloc := Sloc (Def);
 468                   Error_Msg
 469                     ("(style) bad casing of & declared#", Sref);
 470                   return;
 471
 472                --  Else end of identifiers, and they match
 473
 474                else
 475                   return;
 476                end if;
 477             end if;
 478          end if;
 479
 480       --  Case of definition in package Standard
 481
 482       elsif Sdef = Standard_Location then
 483
 484          --  Check case of identifiers in Standard
 485
 486          if Style_Check_Standard then
 487             Tref := Source_Text (Get_Source_File_Index (Sref));
 488
 489             --  Ignore operators
 490
 491             if Tref (Sref) = '"' then
 492                null;
 493
 494             --  Special case of ASCII
 495
 496             else
 497                if Entity (Ref) = Standard_ASCII then
 498                   Cas := All_Upper_Case;
 499
 500                elsif Entity (Ref) in SE (S_LC_A) .. SE (S_LC_Z)
 501                        or else
 502                      Entity (Ref) in SE (S_NUL) .. SE (S_US)
 503                        or else
 504                      Entity (Ref) = SE (S_DEL)
 505                then
 506                   Cas := All_Upper_Case;
 507
 508                else
 509                   Cas := Mixed_Case;
 510                end if;
 511
 512                Nlen  := Length_Of_Name (Chars (Ref));
 513
 514                if Determine_Casing
 515                     (Tref (Sref .. Sref + Source_Ptr (Nlen) - 1)) = Cas
 516                then
 517                   null;
 518                else
 519                   Error_Msg_N
 520                     ("(style) bad casing for entity in Standard", Ref);
 521                end if;
 522             end if;
 523          end if;
 524       end if;
 525    end Check_Identifier;
 526
 527    -----------------------
 528    -- Check_Indentation --
 529    -----------------------
 530
 531    --  In check indentation mode (-gnatyn for n a digit), a new statement or
 532    --  declaration is required to start in a column that is a multiple of the
 533    --  indentiation amount.
 534
 535    procedure Check_Indentation is
 536    begin
 537       if Style_Check_Indentation /= 0 then
 538          if Token_Ptr = First_Non_Blank_Location
 539            and then Start_Column rem Style_Check_Indentation /= 0
 540          then
 541             Error_Msg_SC ("(style) bad indentation");
 542          end if;
 543       end if;
 544    end Check_Indentation;
 545
 546    ----------------------
 547    -- Check_Left_Paren --
 548    ----------------------
 549
 550    --  In tone check mode (-gnatyt), left paren must not be preceded by an
 551    --  identifier character or digit (a separating space is required) and
 552    --  may never be followed by a space.
 553
 554    procedure Check_Left_Paren is
 555       S : Source_Ptr;
 556
 557    begin
 558       if Style_Check_Tokens then
 559          if Token_Ptr > Source_First (Current_Source_File)
 560            and then Identifier_Char (Source (Token_Ptr - 1))
 561          then
 562             Error_Space_Required (Token_Ptr);
 563          end if;
 564
 565          if Source (Scan_Ptr) = ' ' then
 566
 567             --  Allow one or more spaces if followed by comment
 568
 569             S := Scan_Ptr + 1;
 570             loop
 571                if Source (S) = '-' and then Source (S + 1) = '-' then
 572                   return;
 573                elsif Source (S) /= ' ' then
 574                   exit;
 575                else
 576                   S := S + 1;
 577                end if;
 578             end loop;
 579
 580             Error_Space_Not_Allowed (Scan_Ptr);
 581          end if;
 582       end if;
 583    end Check_Left_Paren;
 584
 585    ---------------------------
 586    -- Check_Line_Terminator --
 587    ---------------------------
 588
 589    --  In check blanks at end mode (-gnatyb), lines may not end with a
 590    --  trailing space.
 591
 592    --  In check max line length mode (-gnatym), the line length must
 593    --  not exceed the permitted maximum value.
 594
 595    --  In check form feeds mode (-gnatyf), the line terminator may not
 596    --  be either of the characters FF or VT.
 597
 598    procedure Check_Line_Terminator (Len : Int) is
 599       S : Source_Ptr;
 600
 601    begin
 602       --  Check FF/VT terminators
 603
 604       if Style_Check_Form_Feeds then
 605          if Source (Scan_Ptr) = ASCII.FF then
 606             Error_Msg_S ("(style) form feed not allowed");
 607
 608          elsif Source (Scan_Ptr) = ASCII.VT then
 609             Error_Msg_S ("(style) vertical tab not allowed");
 610          end if;
 611       end if;
 612
 613       --  Check trailing space
 614
 615       if Style_Check_Blanks_At_End then
 616          if Scan_Ptr >= First_Non_Blank_Location then
 617             if Source (Scan_Ptr - 1) = ' ' then
 618                S := Scan_Ptr - 1;
 619
 620                while Source (S - 1) = ' ' loop
 621                   S := S - 1;
 622                end loop;
 623
 624                Error_Msg ("(style) trailing spaces not permitted", S);
 625             end if;
 626          end if;
 627       end if;
 628
 629       --  Check max line length
 630
 631       if Style_Check_Max_Line_Length then
 632          if Len > Style_Max_Line_Length then
 633             Error_Msg
 634               ("(style) this line is too long",
 635                Current_Line_Start + Source_Ptr (Style_Max_Line_Length));
 636          end if;
 637       end if;
 638
 639    end Check_Line_Terminator;
 640
 641    -----------------------
 642    -- Check_Pragma_Name --
 643    -----------------------
 644
 645    --  In check pragma casing mode (-gnatyp), pragma names must be mixed
 646    --  case, i.e. start with an upper case letter, and otherwise lower case,
 647    --  except after an underline character.
 648
 649    procedure Check_Pragma_Name is
 650    begin
 651       if Style_Check_Pragma_Casing then
 652          if Determine_Token_Casing /= Mixed_Case then
 653             Error_Msg_SC ("(style) bad capitalization, mixed case required");
 654          end if;
 655       end if;
 656    end Check_Pragma_Name;
 657
 658    -----------------------
 659    -- Check_Right_Paren --
 660    -----------------------
 661
 662    --  In check tokens mode (-gnatyt), right paren must never be preceded by
 663    --  a space unless it is the initial non-blank character on the line.
 664
 665    procedure Check_Right_Paren is
 666    begin
 667       if Style_Check_Tokens then
 668          if Token_Ptr > First_Non_Blank_Location
 669            and then Source (Token_Ptr - 1) = ' '
 670          then
 671             Error_Space_Not_Allowed (Token_Ptr - 1);
 672          end if;
 673       end if;
 674    end Check_Right_Paren;
 675
 676    ---------------------
 677    -- Check_Semicolon --
 678    ---------------------
 679
 680    --  In check tokens mode (-gnatyt), semicolon does not permit a preceding
 681    --  space and a following space is required.
 682
 683    procedure Check_Semicolon is
 684    begin
 685       if Style_Check_Tokens then
 686          if Scan_Ptr > Source_First (Current_Source_File)
 687            and then Source (Token_Ptr - 1) = ' '
 688          then
 689             Error_Space_Not_Allowed (Token_Ptr - 1);
 690
 691          elsif Source (Scan_Ptr) > ' ' then
 692             Error_Space_Required (Scan_Ptr);
 693          end if;
 694       end if;
 695    end Check_Semicolon;
 696
 697    ----------------
 698    -- Check_Then --
 699    ----------------
 700
 701    --  In check if then layout mode (-gnatyi), we expect a THEN keyword
 702    --  to appear either on the same line as the IF, or on a separate line
 703    --  after multiple conditions. In any case, it may not appear on the
 704    --  line immediately following the line with the IF.
 705
 706    procedure Check_Then (If_Loc : Source_Ptr) is
 707    begin
 708       if Style_Check_If_Then_Layout then
 709          if Get_Physical_Line_Number (Token_Ptr) =
 710             Get_Physical_Line_Number (If_Loc) + 1
 711          then
 712             Error_Msg_SC ("(style) misplaced THEN");
 713          end if;
 714       end if;
 715    end Check_Then;
 716
 717    -------------------------------
 718    -- Check_Unary_Plus_Or_Minus --
 719    -------------------------------
 720
 721    --  In check tokem mode (-gnatyt), unary plus or minus must not be
 722    --  followed by a space.
 723
 724    procedure Check_Unary_Plus_Or_Minus is
 725    begin
 726       if Style_Check_Tokens then
 727          if Source (Scan_Ptr) = ' ' then
 728             Error_Space_Not_Allowed (Scan_Ptr);
 729          end if;
 730       end if;
 731    end Check_Unary_Plus_Or_Minus;
 732
 733    ------------------------
 734    -- Check_Vertical_Bar --
 735    ------------------------
 736
 737    --  In check token mode (-gnatyt), vertical bar must be surrounded by spaces
 738
 739    procedure Check_Vertical_Bar is
 740    begin
 741       if Style_Check_Tokens then
 742          Require_Preceding_Space;
 743          Require_Following_Space;
 744       end if;
 745    end Check_Vertical_Bar;
 746
 747    -----------------------------
 748    -- Error_Space_Not_Allowed --
 749    -----------------------------
 750
 751    procedure Error_Space_Not_Allowed (S : Source_Ptr) is
 752    begin
 753       Error_Msg ("(style) space not allowed", S);
 754    end Error_Space_Not_Allowed;
 755
 756    --------------------------
 757    -- Error_Space_Required --
 758    --------------------------
 759
 760    procedure Error_Space_Required (S : Source_Ptr) is
 761    begin
 762       Error_Msg ("(style) space required", S);
 763    end Error_Space_Required;
 764
 765    -----------------
 766    -- No_End_Name --
 767    -----------------
 768
 769    --  In check end/exit labels mode (-gnatye), always require the name of
 770    --  a subprogram or package to be present on the END, so this is an error.
 771
 772    procedure No_End_Name (Name : Node_Id) is
 773    begin
 774       if Style_Check_End_Labels then
 775          Error_Msg_Node_1 := Name;
 776          Error_Msg_SP ("(style) `END &` required");
 777       end if;
 778    end No_End_Name;
 779
 780    ------------------
 781    -- No_Exit_Name --
 782    ------------------
 783
 784    --  In check end/exit labels mode (-gnatye), always require the name of
 785    --  the loop to be present on the EXIT when exiting a named loop.
 786
 787    procedure No_Exit_Name (Name : Node_Id) is
 788    begin
 789       if Style_Check_End_Labels then
 790          Error_Msg_Node_1 := Name;
 791          Error_Msg_SP ("(style) `EXIT &` required");
 792       end if;
 793    end No_Exit_Name;
 794
 795    ----------------------------
 796    -- Non_Lower_Case_Keyword --
 797    ----------------------------
 798
 799    --  In check casing mode (-gnatyk), reserved keywords must be be spelled
 800    --  in all lower case (excluding keywords range, access, delta and digits
 801    --  used as attribute designators).
 802
 803    procedure Non_Lower_Case_Keyword is
 804    begin
 805       if Style_Check_Keyword_Casing then
 806          Error_Msg_SC ("(style) reserved words must be all lower case");
 807       end if;
 808    end Non_Lower_Case_Keyword;
 809
 810    -----------------------------
 811    -- Require_Following_Space --
 812    -----------------------------
 813
 814    procedure Require_Following_Space is
 815    begin
 816       if Source (Scan_Ptr) > ' ' then
 817          Error_Space_Required (Scan_Ptr);
 818       end if;
 819    end Require_Following_Space;
 820
 821    -----------------------------
 822    -- Require_Preceding_Space --
 823    -----------------------------
 824
 825    procedure Require_Preceding_Space is
 826    begin
 827       if Token_Ptr > Source_First (Current_Source_File)
 828         and then Source (Token_Ptr - 1) > ' '
 829       then
 830          Error_Space_Required (Token_Ptr);
 831       end if;
 832    end Require_Preceding_Space;
 833
 834    ---------------------
 835    -- RM_Column_Check --
 836    ---------------------
 837
 838    function RM_Column_Check return Boolean is
 839    begin
 840       return Style_Check and Style_Check_Layout;
 841    end RM_Column_Check;
 842
 843    -----------------------------------
 844    -- Subprogram_Not_In_Alpha_Order --
 845    -----------------------------------
 846
 847    procedure Subprogram_Not_In_Alpha_Order (Name : Node_Id) is
 848    begin
 849       if Style_Check_Subprogram_Order then
 850          Error_Msg_N
 851            ("(style) subprogram body& not in alphabetical order", Name);
 852       end if;
 853    end Subprogram_Not_In_Alpha_Order;
 854 end Style;