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