gcc/ada/styleg.adb

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