gcc/ada/scng.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                 S C N G                                  --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Csets;    use Csets;
  27 with Err_Vars; use Err_Vars;
  28 with Hostparm; use Hostparm;
  29 with Namet;    use Namet;
  30 with Opt;      use Opt;
  31 with Restrict; use Restrict;
  32 with Rident;   use Rident;
  33 with Scans;    use Scans;
  34 with Sinput;   use Sinput;
  35 with Snames;   use Snames;
  36 with Stringt;  use Stringt;
  37 with Stylesw;  use Stylesw;
  38 with Uintp;    use Uintp;
  39 with Urealp;   use Urealp;
  40 with Widechar; use Widechar;
  41
  42 pragma Warnings (Off);
  43 --  This package is used also by gnatcoll
  44 with System.CRC32;
  45 with System.UTF_32;  use System.UTF_32;
  46 with System.WCh_Con; use System.WCh_Con;
  47 pragma Warnings (On);
  48
  49 package body Scng is
  50
  51    use ASCII;
  52    --  Make control characters visible
  53
  54    Special_Characters : array (Character) of Boolean := (others => False);
  55    --  For characters that are Special token, the value is True
  56
  57    Comment_Is_Token : Boolean := False;
  58    --  True if comments are tokens
  59
  60    End_Of_Line_Is_Token : Boolean := False;
  61    --  True if End_Of_Line is a token
  62
  63    -----------------------
  64    -- Local Subprograms --
  65    -----------------------
  66
  67    procedure Accumulate_Token_Checksum;
  68    pragma Inline (Accumulate_Token_Checksum);
  69    --  Called after each numeric literal and identifier/keyword. For keywords,
  70    --  the token used is Tok_Identifier. This allows to detect additional
  71    --  spaces added in sources when using the builder switch -m.
  72
  73    procedure Accumulate_Token_Checksum_GNAT_6_3;
  74    --  Used in place of Accumulate_Token_Checksum for GNAT versions 5.04 to
  75    --  6.3, when Tok_Some was not included in Token_Type and the actual
  76    --  Token_Type was used for keywords. This procedure is never used in the
  77    --  compiler or gnatmake, only in gprbuild.
  78
  79    procedure Accumulate_Token_Checksum_GNAT_5_03;
  80    --  Used in place of Accumulate_Token_Checksum for GNAT version 5.03, when
  81    --  Tok_Interface, Tok_Some, Tok_Synchronized and Tok_Overriding were not
  82    --  included in Token_Type and the actual Token_Type was used for keywords.
  83    --  This procedure is never used in the compiler or gnatmake, only in
  84    --  gprbuild.
  85
  86    procedure Accumulate_Checksum (C : Character);
  87    pragma Inline (Accumulate_Checksum);
  88    --  This routine accumulates the checksum given character C. During the
  89    --  scanning of a source file, this routine is called with every character
  90    --  in the source, excluding blanks, and all control characters (except
  91    --  that ESC is included in the checksum). Upper case letters not in string
  92    --  literals are folded by the caller. See Sinput spec for the documentation
  93    --  of the checksum algorithm. Note: checksum values are only used if we
  94    --  generate code, so it is not necessary to worry about making the right
  95    --  sequence of calls in any error situation.
  96
  97    procedure Accumulate_Checksum (C : Char_Code);
  98    pragma Inline (Accumulate_Checksum);
  99    --  This version is identical, except that the argument, C, is a character
 100    --  code value instead of a character. This is used when wide characters
 101    --  are scanned. We use the character code rather than the ASCII characters
 102    --  so that the checksum is independent of wide character encoding method.
 103
 104    procedure Initialize_Checksum;
 105    pragma Inline (Initialize_Checksum);
 106    --  Initialize checksum value
 107
 108    -------------------------
 109    -- Accumulate_Checksum --
 110    -------------------------
 111
 112    procedure Accumulate_Checksum (C : Character) is
 113    begin
 114       System.CRC32.Update (System.CRC32.CRC32 (Checksum), C);
 115    end Accumulate_Checksum;
 116
 117    procedure Accumulate_Checksum (C : Char_Code) is
 118    begin
 119       if C > 16#FFFF# then
 120          Accumulate_Checksum (Character'Val (C / 2 ** 24));
 121          Accumulate_Checksum (Character'Val ((C / 2 ** 16) mod 256));
 122          Accumulate_Checksum (Character'Val ((C / 256) mod 256));
 123       else
 124          Accumulate_Checksum (Character'Val (C / 256));
 125       end if;
 126
 127       Accumulate_Checksum (Character'Val (C mod 256));
 128    end Accumulate_Checksum;
 129
 130    -------------------------------
 131    -- Accumulate_Token_Checksum --
 132    -------------------------------
 133
 134    procedure Accumulate_Token_Checksum is
 135    begin
 136       System.CRC32.Update
 137         (System.CRC32.CRC32 (Checksum),
 138          Character'Val (Token_Type'Pos (Token)));
 139    end Accumulate_Token_Checksum;
 140
 141    ----------------------------------------
 142    -- Accumulate_Token_Checksum_GNAT_6_3 --
 143    ----------------------------------------
 144
 145    procedure Accumulate_Token_Checksum_GNAT_6_3 is
 146    begin
 147       --  Individual values of Token_Type are used, instead of subranges, so
 148       --  that additions or suppressions of enumerated values in type
 149       --  Token_Type are detected by the compiler.
 150
 151       case Token is
 152          when Tok_Integer_Literal | Tok_Real_Literal | Tok_String_Literal |
 153               Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier |
 154               Tok_Double_Asterisk | Tok_Ampersand | Tok_Minus | Tok_Plus |
 155               Tok_Asterisk | Tok_Mod | Tok_Rem | Tok_Slash | Tok_New |
 156               Tok_Abs | Tok_Others | Tok_Null | Tok_Dot | Tok_Apostrophe |
 157               Tok_Left_Paren | Tok_Delta | Tok_Digits | Tok_Range |
 158               Tok_Right_Paren | Tok_Comma | Tok_And | Tok_Or | Tok_Xor |
 159               Tok_Less | Tok_Equal | Tok_Greater | Tok_Not_Equal |
 160               Tok_Greater_Equal | Tok_Less_Equal | Tok_In | Tok_Not |
 161               Tok_Box | Tok_Colon_Equal | Tok_Colon | Tok_Greater_Greater |
 162               Tok_Abstract | Tok_Access | Tok_Aliased | Tok_All | Tok_Array |
 163               Tok_At | Tok_Body | Tok_Constant | Tok_Do | Tok_Is |
 164               Tok_Interface | Tok_Limited | Tok_Of | Tok_Out | Tok_Record |
 165               Tok_Renames | Tok_Reverse =>
 166
 167             System.CRC32.Update
 168               (System.CRC32.CRC32 (Checksum),
 169                Character'Val (Token_Type'Pos (Token)));
 170
 171          when Tok_Some =>
 172
 173             System.CRC32.Update
 174               (System.CRC32.CRC32 (Checksum),
 175                Character'Val (Token_Type'Pos (Tok_Identifier)));
 176
 177          when Tok_Tagged | Tok_Then | Tok_Less_Less | Tok_Abort | Tok_Accept |
 178               Tok_Case | Tok_Delay | Tok_Else | Tok_Elsif | Tok_End |
 179               Tok_Exception | Tok_Exit | Tok_Goto | Tok_If | Tok_Pragma |
 180               Tok_Raise | Tok_Requeue | Tok_Return | Tok_Select |
 181               Tok_Terminate | Tok_Until | Tok_When | Tok_Begin | Tok_Declare |
 182               Tok_For | Tok_Loop | Tok_While | Tok_Entry | Tok_Protected |
 183               Tok_Task | Tok_Type | Tok_Subtype | Tok_Overriding |
 184               Tok_Synchronized | Tok_Use | Tok_Function | Tok_Generic |
 185               Tok_Package | Tok_Procedure | Tok_Private | Tok_With |
 186               Tok_Separate | Tok_EOF | Tok_Semicolon | Tok_Arrow |
 187               Tok_Vertical_Bar | Tok_Dot_Dot | Tok_Project | Tok_Extends |
 188               Tok_External | Tok_External_As_List | Tok_Comment |
 189               Tok_End_Of_Line | Tok_Special | Tok_SPARK_Hide | No_Token =>
 190
 191             System.CRC32.Update
 192               (System.CRC32.CRC32 (Checksum),
 193                Character'Val (Token_Type'Pos (Token_Type'Pred (Token))));
 194       end case;
 195    end Accumulate_Token_Checksum_GNAT_6_3;
 196
 197    -----------------------------------------
 198    -- Accumulate_Token_Checksum_GNAT_5_03 --
 199    -----------------------------------------
 200
 201    procedure Accumulate_Token_Checksum_GNAT_5_03 is
 202    begin
 203       --  Individual values of Token_Type are used, instead of subranges, so
 204       --  that additions or suppressions of enumerated values in type
 205       --  Token_Type are detected by the compiler.
 206
 207       case Token is
 208          when Tok_Integer_Literal | Tok_Real_Literal | Tok_String_Literal |
 209               Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier |
 210               Tok_Double_Asterisk | Tok_Ampersand | Tok_Minus | Tok_Plus |
 211               Tok_Asterisk | Tok_Mod | Tok_Rem | Tok_Slash | Tok_New |
 212               Tok_Abs | Tok_Others | Tok_Null | Tok_Dot | Tok_Apostrophe |
 213               Tok_Left_Paren | Tok_Delta | Tok_Digits | Tok_Range |
 214               Tok_Right_Paren | Tok_Comma | Tok_And | Tok_Or | Tok_Xor |
 215               Tok_Less | Tok_Equal | Tok_Greater | Tok_Not_Equal |
 216               Tok_Greater_Equal | Tok_Less_Equal | Tok_In | Tok_Not |
 217               Tok_Box | Tok_Colon_Equal | Tok_Colon | Tok_Greater_Greater |
 218               Tok_Abstract | Tok_Access | Tok_Aliased | Tok_All | Tok_Array |
 219               Tok_At | Tok_Body | Tok_Constant | Tok_Do | Tok_Is =>
 220
 221             System.CRC32.Update
 222               (System.CRC32.CRC32 (Checksum),
 223                Character'Val (Token_Type'Pos (Token)));
 224
 225          when Tok_Interface | Tok_Some | Tok_Overriding | Tok_Synchronized =>
 226             System.CRC32.Update
 227               (System.CRC32.CRC32 (Checksum),
 228                Character'Val (Token_Type'Pos (Tok_Identifier)));
 229
 230          when Tok_Limited | Tok_Of | Tok_Out | Tok_Record |
 231               Tok_Renames | Tok_Reverse =>
 232
 233             System.CRC32.Update
 234               (System.CRC32.CRC32 (Checksum),
 235                Character'Val (Token_Type'Pos (Token) - 1));
 236
 237          when Tok_Tagged | Tok_Then | Tok_Less_Less | Tok_Abort | Tok_Accept |
 238               Tok_Case | Tok_Delay | Tok_Else | Tok_Elsif | Tok_End |
 239               Tok_Exception | Tok_Exit | Tok_Goto | Tok_If | Tok_Pragma |
 240               Tok_Raise | Tok_Requeue | Tok_Return | Tok_Select |
 241               Tok_Terminate | Tok_Until | Tok_When | Tok_Begin | Tok_Declare |
 242               Tok_For | Tok_Loop | Tok_While | Tok_Entry | Tok_Protected |
 243               Tok_Task | Tok_Type | Tok_Subtype =>
 244
 245             System.CRC32.Update
 246               (System.CRC32.CRC32 (Checksum),
 247                Character'Val (Token_Type'Pos (Token) - 2));
 248
 249          when Tok_Use | Tok_Function | Tok_Generic |
 250               Tok_Package | Tok_Procedure | Tok_Private | Tok_With |
 251               Tok_Separate | Tok_EOF | Tok_Semicolon | Tok_Arrow |
 252               Tok_Vertical_Bar | Tok_Dot_Dot | Tok_Project | Tok_Extends |
 253               Tok_External | Tok_External_As_List | Tok_Comment |
 254               Tok_End_Of_Line | Tok_Special | Tok_SPARK_Hide | No_Token =>
 255
 256             System.CRC32.Update
 257               (System.CRC32.CRC32 (Checksum),
 258                Character'Val (Token_Type'Pos (Token) - 4));
 259       end case;
 260    end Accumulate_Token_Checksum_GNAT_5_03;
 261
 262    ----------------------------
 263    -- Determine_Token_Casing --
 264    ----------------------------
 265
 266    function Determine_Token_Casing return Casing_Type is
 267    begin
 268       return Determine_Casing (Source (Token_Ptr .. Scan_Ptr - 1));
 269    end Determine_Token_Casing;
 270
 271    -------------------------
 272    -- Initialize_Checksum --
 273    -------------------------
 274
 275    procedure Initialize_Checksum is
 276    begin
 277       System.CRC32.Initialize (System.CRC32.CRC32 (Checksum));
 278    end Initialize_Checksum;
 279
 280    ------------------------
 281    -- Initialize_Scanner --
 282    ------------------------
 283
 284    procedure Initialize_Scanner (Index : Source_File_Index) is
 285    begin
 286       --  Establish reserved words
 287
 288       Scans.Initialize_Ada_Keywords;
 289
 290       --  Initialize scan control variables
 291
 292       Current_Source_File       := Index;
 293       Source                    := Source_Text (Current_Source_File);
 294       Scan_Ptr                  := Source_First (Current_Source_File);
 295       Token                     := No_Token;
 296       Token_Ptr                 := Scan_Ptr;
 297       Current_Line_Start        := Scan_Ptr;
 298       Token_Node                := Empty;
 299       Token_Name                := No_Name;
 300       Start_Column              := Set_Start_Column;
 301       First_Non_Blank_Location  := Scan_Ptr;
 302
 303       Initialize_Checksum;
 304       Wide_Char_Byte_Count := 0;
 305
 306       --  Do not call Scan, otherwise the License stuff does not work in Scn
 307
 308    end Initialize_Scanner;
 309
 310    ------------------------------
 311    -- Reset_Special_Characters --
 312    ------------------------------
 313
 314    procedure Reset_Special_Characters is
 315    begin
 316       Special_Characters := (others => False);
 317    end Reset_Special_Characters;
 318
 319    ----------
 320    -- Scan --
 321    ----------
 322
 323    procedure Scan is
 324
 325       Start_Of_Comment : Source_Ptr;
 326       --  Record start of comment position
 327
 328       Underline_Found : Boolean;
 329       --  During scanning of an identifier, set to True if last character
 330       --  scanned was an underline or other punctuation character. This
 331       --  is used to flag the error of two underlines/punctuations in a
 332       --  row or ending an identifier with a underline/punctuation. Here
 333       --  punctuation means any UTF_32 character in the Unicode category
 334       --  Punctuation,Connector.
 335
 336       Wptr : Source_Ptr;
 337       --  Used to remember start of last wide character scanned
 338
 339       procedure Check_End_Of_Line;
 340       --  Called when end of line encountered. Checks that line is not too
 341       --  long, and that other style checks for the end of line are met.
 342
 343       function Double_Char_Token (C : Character) return Boolean;
 344       --  This function is used for double character tokens like := or <>. It
 345       --  checks if the character following Source (Scan_Ptr) is C, and if so
 346       --  bumps Scan_Ptr past the pair of characters and returns True. A space
 347       --  between the two characters is also recognized with an appropriate
 348       --  error message being issued. If C is not present, False is returned.
 349       --  Note that Double_Char_Token can only be used for tokens defined in
 350       --  the Ada syntax (it's use for error cases like && is not appropriate
 351       --  since we do not want a junk message for a case like &-space-&).
 352
 353       procedure Error_Illegal_Character;
 354       --  Give illegal character error, Scan_Ptr points to character. On
 355       --  return, Scan_Ptr is bumped past the illegal character.
 356
 357       procedure Error_Illegal_Wide_Character;
 358       --  Give illegal wide character message. On return, Scan_Ptr is bumped
 359       --  past the illegal character, which may still leave us pointing to
 360       --  junk, not much we can do if the escape sequence is messed up!
 361
 362       procedure Error_Long_Line;
 363       --  Signal error of excessively long line
 364
 365       procedure Error_No_Double_Underline;
 366       --  Signal error of two underline or punctuation characters in a row.
 367       --  Called with Scan_Ptr pointing to second underline/punctuation char.
 368
 369       procedure Nlit;
 370       --  This is the procedure for scanning out numeric literals. On entry,
 371       --  Scan_Ptr points to the digit that starts the numeric literal (the
 372       --  checksum for this character has not been accumulated yet). On return
 373       --  Scan_Ptr points past the last character of the numeric literal, Token
 374       --  and Token_Node are set appropriately, and the checksum is updated.
 375
 376       procedure Slit;
 377       --  This is the procedure for scanning out string literals. On entry,
 378       --  Scan_Ptr points to the opening string quote (the checksum for this
 379       --  character has not been accumulated yet). On return Scan_Ptr points
 380       --  past the closing quote of the string literal, Token and Token_Node
 381       --  are set appropriately, and the checksum is updated.
 382
 383       procedure Skip_Other_Format_Characters;
 384       --  Skips past any "other format" category characters at the current
 385       --  cursor location (does not skip past spaces or any other characters).
 386
 387       function Start_Of_Wide_Character return Boolean;
 388       --  Returns True if the scan pointer is pointing to the start of a wide
 389       --  character sequence, does not modify the scan pointer in any case.
 390
 391       -----------------------
 392       -- Check_End_Of_Line --
 393       -----------------------
 394
 395       procedure Check_End_Of_Line is
 396          Len : constant Int :=
 397                  Int (Scan_Ptr) -
 398                  Int (Current_Line_Start) -
 399                  Wide_Char_Byte_Count;
 400
 401       begin
 402          if Style_Check then
 403             Style.Check_Line_Terminator (Len);
 404          end if;
 405
 406          --  Deal with checking maximum line length
 407
 408          if Style_Check and Style_Check_Max_Line_Length then
 409             Style.Check_Line_Max_Length (Len);
 410
 411          --  If style checking is inactive, check maximum line length against
 412          --  standard value.
 413
 414          elsif Len > Max_Line_Length then
 415             Error_Long_Line;
 416          end if;
 417
 418          --  Now one more checking circuit. Normally we are only enforcing a
 419          --  limit of physical characters, with tabs counting as one character.
 420          --  But if after tab expansion we would have a total line length that
 421          --  exceeded 32766, that would really cause trouble, because column
 422          --  positions would exceed the maximum we allow for a column count.
 423          --  Note: the limit is 32766 rather than 32767, since we use a value
 424          --  of 32767 for special purposes (see Sinput). Now we really do not
 425          --  want to go messing with tabs in the normal case, so what we do is
 426          --  to check for a line that has more than 4096 physical characters.
 427          --  Any shorter line could not be a problem, even if it was all tabs.
 428
 429          if Len >= 4096 then
 430             declare
 431                Col : Natural;
 432                Ptr : Source_Ptr;
 433
 434             begin
 435                Col := 1;
 436                Ptr := Current_Line_Start;
 437                loop
 438                   exit when Ptr = Scan_Ptr;
 439
 440                   if Source (Ptr) = ASCII.HT then
 441                      Col := (Col - 1 + 8) / 8 * 8 + 1;
 442                   else
 443                      Col := Col + 1;
 444                   end if;
 445
 446                   if Col > 32766 then
 447                      Error_Msg
 448                        ("this line is longer than 32766 characters",
 449                         Current_Line_Start);
 450                      raise Unrecoverable_Error;
 451                   end if;
 452
 453                   Ptr := Ptr + 1;
 454                end loop;
 455             end;
 456          end if;
 457
 458          --  Reset wide character byte count for next line
 459
 460          Wide_Char_Byte_Count := 0;
 461       end Check_End_Of_Line;
 462
 463       -----------------------
 464       -- Double_Char_Token --
 465       -----------------------
 466
 467       function Double_Char_Token (C : Character) return Boolean is
 468       begin
 469          if Source (Scan_Ptr + 1) = C then
 470             Accumulate_Checksum (C);
 471             Scan_Ptr := Scan_Ptr + 2;
 472             return True;
 473
 474          elsif Source (Scan_Ptr + 1) = ' '
 475            and then Source (Scan_Ptr + 2) = C
 476          then
 477             Scan_Ptr := Scan_Ptr + 1;
 478             Error_Msg_S -- CODEFIX
 479               ("no space allowed here");
 480             Scan_Ptr := Scan_Ptr + 2;
 481             return True;
 482
 483          else
 484             return False;
 485          end if;
 486       end Double_Char_Token;
 487
 488       -----------------------------
 489       -- Error_Illegal_Character --
 490       -----------------------------
 491
 492       procedure Error_Illegal_Character is
 493       begin
 494          Error_Msg_S ("illegal character");
 495          Scan_Ptr := Scan_Ptr + 1;
 496       end Error_Illegal_Character;
 497
 498       ----------------------------------
 499       -- Error_Illegal_Wide_Character --
 500       ----------------------------------
 501
 502       procedure Error_Illegal_Wide_Character is
 503       begin
 504          Scan_Ptr := Scan_Ptr + 1;
 505          Error_Msg ("illegal wide character", Wptr);
 506       end Error_Illegal_Wide_Character;
 507
 508       ---------------------
 509       -- Error_Long_Line --
 510       ---------------------
 511
 512       procedure Error_Long_Line is
 513       begin
 514          Error_Msg
 515            ("this line is too long",
 516             Current_Line_Start + Source_Ptr (Max_Line_Length));
 517       end Error_Long_Line;
 518
 519       -------------------------------
 520       -- Error_No_Double_Underline --
 521       -------------------------------
 522
 523       procedure Error_No_Double_Underline is
 524       begin
 525          Underline_Found := False;
 526
 527          --  There are four cases, and we special case the messages
 528
 529          if Source (Scan_Ptr) = '_' then
 530             if Source (Scan_Ptr - 1) = '_' then
 531                Error_Msg_S -- CODEFIX
 532                  ("two consecutive underlines not permitted");
 533             else
 534                Error_Msg_S ("underline cannot follow punctuation character");
 535             end if;
 536
 537          else
 538             if Source (Scan_Ptr - 1) = '_' then
 539                Error_Msg_S ("punctuation character cannot follow underline");
 540             else
 541                Error_Msg_S
 542                  ("two consecutive punctuation characters not permitted");
 543             end if;
 544          end if;
 545       end Error_No_Double_Underline;
 546
 547       ----------
 548       -- Nlit --
 549       ----------
 550
 551       procedure Nlit is
 552
 553          C : Character;
 554          --  Current source program character
 555
 556          Base_Char : Character;
 557          --  Either # or : (character at start of based number)
 558
 559          Base : Int;
 560          --  Value of base
 561
 562          UI_Base : Uint;
 563          --  Value of base in Uint format
 564
 565          UI_Int_Value : Uint;
 566          --  Value of integer scanned by Scan_Integer in Uint format
 567
 568          UI_Num_Value : Uint;
 569          --  Value of integer in numeric value being scanned
 570
 571          Scale : Int;
 572          --  Scale value for real literal
 573
 574          UI_Scale : Uint;
 575          --  Scale in Uint format
 576
 577          Exponent_Is_Negative : Boolean;
 578          --  Set true for negative exponent
 579
 580          Extended_Digit_Value : Int;
 581          --  Extended digit value
 582
 583          Point_Scanned : Boolean;
 584          --  Flag for decimal point scanned in numeric literal
 585
 586          -----------------------
 587          -- Local Subprograms --
 588          -----------------------
 589
 590          procedure Error_Digit_Expected;
 591          --  Signal error of bad digit, Scan_Ptr points to the location at
 592          --  which the digit was expected on input, and is unchanged on return.
 593
 594          procedure Scan_Integer;
 595          --  Procedure to scan integer literal. On entry, Scan_Ptr points to a
 596          --  digit, on exit Scan_Ptr points past the last character of the
 597          --  integer.
 598          --
 599          --  For each digit encountered, UI_Int_Value is multiplied by 10, and
 600          --  the value of the digit added to the result. In addition, the
 601          --  value in Scale is decremented by one for each actual digit
 602          --  scanned.
 603
 604          --------------------------
 605          -- Error_Digit_Expected --
 606          --------------------------
 607
 608          procedure Error_Digit_Expected is
 609          begin
 610             Error_Msg_S ("digit expected");
 611          end Error_Digit_Expected;
 612
 613          ------------------
 614          -- Scan_Integer --
 615          ------------------
 616
 617          procedure Scan_Integer is
 618             C : Character;
 619             --  Next character scanned
 620
 621          begin
 622             C := Source (Scan_Ptr);
 623
 624             --  Loop through digits (allowing underlines)
 625
 626             loop
 627                Accumulate_Checksum (C);
 628                UI_Int_Value :=
 629                  UI_Int_Value * 10 + (Character'Pos (C) - Character'Pos ('0'));
 630                Scan_Ptr := Scan_Ptr + 1;
 631                Scale := Scale - 1;
 632                C := Source (Scan_Ptr);
 633
 634                --  Case of underline encountered
 635
 636                if C = '_' then
 637
 638                   --  We do not accumulate the '_' in the checksum, so that
 639                   --  1_234 is equivalent to 1234, and does not trigger
 640                   --  compilation for "minimal recompilation" (gnatmake -m).
 641
 642                   loop
 643                      Scan_Ptr := Scan_Ptr + 1;
 644                      C := Source (Scan_Ptr);
 645                      exit when C /= '_';
 646                      Error_No_Double_Underline;
 647                   end loop;
 648
 649                   if C not in '0' .. '9' then
 650                      Error_Digit_Expected;
 651                      exit;
 652                   end if;
 653
 654                else
 655                   exit when C not in '0' .. '9';
 656                end if;
 657             end loop;
 658          end Scan_Integer;
 659
 660       --  Start of Processing for Nlit
 661
 662       begin
 663          Base := 10;
 664          UI_Base := Uint_10;
 665          UI_Int_Value := Uint_0;
 666          Based_Literal_Uses_Colon := False;
 667          Scale := 0;
 668          Scan_Integer;
 669          Point_Scanned := False;
 670          UI_Num_Value := UI_Int_Value;
 671
 672          --  Various possibilities now for continuing the literal are period,
 673          --  E/e (for exponent), or :/# (for based literal).
 674
 675          Scale := 0;
 676          C := Source (Scan_Ptr);
 677
 678          if C = '.' then
 679
 680             --  Scan out point, but do not scan past .. which is a range
 681             --  sequence, and must not be eaten up scanning a numeric literal.
 682
 683             while C = '.' and then Source (Scan_Ptr + 1) /= '.' loop
 684                Accumulate_Checksum ('.');
 685
 686                if Point_Scanned then
 687                   Error_Msg_S ("duplicate point ignored");
 688                end if;
 689
 690                Point_Scanned := True;
 691                Scan_Ptr := Scan_Ptr + 1;
 692                C := Source (Scan_Ptr);
 693
 694                if C not in '0' .. '9' then
 695                   Error_Msg
 696                     ("real literal cannot end with point", Scan_Ptr - 1);
 697                else
 698                   Scan_Integer;
 699                   UI_Num_Value := UI_Int_Value;
 700                end if;
 701             end loop;
 702
 703          --  Based literal case. The base is the value we already scanned.
 704          --  In the case of colon, we insist that the following character
 705          --  is indeed an extended digit or a period. This catches a number
 706          --  of common errors, as well as catching the well known tricky
 707          --  bug otherwise arising from "x : integer range 1 .. 10:= 6;"
 708
 709          elsif C = '#'
 710            or else (C = ':' and then
 711                       (Source (Scan_Ptr + 1) = '.'
 712                          or else
 713                        Source (Scan_Ptr + 1) in '0' .. '9'
 714                          or else
 715                        Source (Scan_Ptr + 1) in 'A' .. 'Z'
 716                          or else
 717                        Source (Scan_Ptr + 1) in 'a' .. 'z'))
 718          then
 719             Accumulate_Checksum (C);
 720             Base_Char := C;
 721             UI_Base := UI_Int_Value;
 722
 723             if Base_Char = ':' then
 724                Based_Literal_Uses_Colon := True;
 725             end if;
 726
 727             if UI_Base < 2 or else UI_Base > 16 then
 728                Error_Msg_SC ("base not 2-16");
 729                UI_Base := Uint_16;
 730             end if;
 731
 732             Base := UI_To_Int (UI_Base);
 733             Scan_Ptr := Scan_Ptr + 1;
 734
 735             --  Scan out extended integer [. integer]
 736
 737             C := Source (Scan_Ptr);
 738             UI_Int_Value := Uint_0;
 739             Scale := 0;
 740
 741             loop
 742                if C in '0' .. '9' then
 743                   Accumulate_Checksum (C);
 744                   Extended_Digit_Value :=
 745                     Int'(Character'Pos (C)) - Int'(Character'Pos ('0'));
 746
 747                elsif C in 'A' .. 'F' then
 748                   Accumulate_Checksum (Character'Val (Character'Pos (C) + 32));
 749                   Extended_Digit_Value :=
 750                     Int'(Character'Pos (C)) - Int'(Character'Pos ('A')) + 10;
 751
 752                elsif C in 'a' .. 'f' then
 753                   Accumulate_Checksum (C);
 754                   Extended_Digit_Value :=
 755                     Int'(Character'Pos (C)) - Int'(Character'Pos ('a')) + 10;
 756
 757                else
 758                   Error_Msg_S ("extended digit expected");
 759                   exit;
 760                end if;
 761
 762                if Extended_Digit_Value >= Base then
 763                   Error_Msg_S ("digit '>= base");
 764                end if;
 765
 766                UI_Int_Value := UI_Int_Value * UI_Base + Extended_Digit_Value;
 767                Scale := Scale - 1;
 768                Scan_Ptr := Scan_Ptr + 1;
 769                C := Source (Scan_Ptr);
 770
 771                if C = '_' then
 772                   loop
 773                      Accumulate_Checksum ('_');
 774                      Scan_Ptr := Scan_Ptr + 1;
 775                      C := Source (Scan_Ptr);
 776                      exit when C /= '_';
 777                      Error_No_Double_Underline;
 778                   end loop;
 779
 780                elsif C = '.' then
 781                   Accumulate_Checksum ('.');
 782
 783                   if Point_Scanned then
 784                      Error_Msg_S ("duplicate point ignored");
 785                   end if;
 786
 787                   Scan_Ptr := Scan_Ptr + 1;
 788                   C := Source (Scan_Ptr);
 789                   Point_Scanned := True;
 790                   Scale := 0;
 791
 792                elsif C = Base_Char then
 793                   Accumulate_Checksum (C);
 794                   Scan_Ptr := Scan_Ptr + 1;
 795                   exit;
 796
 797                elsif C = '#' or else C = ':' then
 798                   Error_Msg_S ("based number delimiters must match");
 799                   Scan_Ptr := Scan_Ptr + 1;
 800                   exit;
 801
 802                elsif not Identifier_Char (C) then
 803                   if Base_Char = '#' then
 804                      Error_Msg_S -- CODEFIX
 805                        ("missing '#");
 806                   else
 807                      Error_Msg_S -- CODEFIX
 808                        ("missing ':");
 809                   end if;
 810
 811                   exit;
 812                end if;
 813
 814             end loop;
 815
 816             UI_Num_Value := UI_Int_Value;
 817          end if;
 818
 819          --  Scan out exponent
 820
 821          if not Point_Scanned then
 822             Scale := 0;
 823             UI_Scale := Uint_0;
 824          else
 825             UI_Scale := UI_From_Int (Scale);
 826          end if;
 827
 828          if Source (Scan_Ptr) = 'e' or else Source (Scan_Ptr) = 'E' then
 829             Accumulate_Checksum ('e');
 830             Scan_Ptr := Scan_Ptr + 1;
 831             Exponent_Is_Negative := False;
 832
 833             if Source (Scan_Ptr) = '+' then
 834                Accumulate_Checksum ('+');
 835                Scan_Ptr := Scan_Ptr + 1;
 836
 837             elsif Source (Scan_Ptr) = '-' then
 838                Accumulate_Checksum ('-');
 839
 840                if not Point_Scanned then
 841                   Error_Msg_S
 842                     ("negative exponent not allowed for integer literal");
 843                else
 844                   Exponent_Is_Negative := True;
 845                end if;
 846
 847                Scan_Ptr := Scan_Ptr + 1;
 848             end if;
 849
 850             UI_Int_Value := Uint_0;
 851
 852             if Source (Scan_Ptr) in '0' .. '9' then
 853                Scan_Integer;
 854             else
 855                Error_Digit_Expected;
 856             end if;
 857
 858             if Exponent_Is_Negative then
 859                UI_Scale := UI_Scale - UI_Int_Value;
 860             else
 861                UI_Scale := UI_Scale + UI_Int_Value;
 862             end if;
 863          end if;
 864
 865          --  Case of real literal to be returned
 866
 867          if Point_Scanned then
 868             Token := Tok_Real_Literal;
 869             Real_Literal_Value :=
 870               UR_From_Components (
 871                                   Num   => UI_Num_Value,
 872                                   Den   => -UI_Scale,
 873                                   Rbase => Base);
 874
 875          --  Case of integer literal to be returned
 876
 877          else
 878             Token := Tok_Integer_Literal;
 879
 880             if UI_Scale = 0 then
 881                Int_Literal_Value := UI_Num_Value;
 882
 883             --  Avoid doing possibly expensive calculations in cases like
 884             --  parsing 163E800_000# when semantics will not be done anyway.
 885             --  This is especially useful when parsing garbled input.
 886
 887             elsif Operating_Mode /= Check_Syntax
 888               and then (Serious_Errors_Detected = 0 or else Try_Semantics)
 889             then
 890                Int_Literal_Value := UI_Num_Value * UI_Base ** UI_Scale;
 891
 892             else
 893                Int_Literal_Value := No_Uint;
 894             end if;
 895          end if;
 896
 897          if Checksum_Accumulate_Token_Checksum then
 898             Accumulate_Token_Checksum;
 899          end if;
 900
 901          return;
 902       end Nlit;
 903
 904       ----------
 905       -- Slit --
 906       ----------
 907
 908       procedure Slit is
 909
 910          Delimiter : Character;
 911          --  Delimiter (first character of string)
 912
 913          C : Character;
 914          --  Current source program character
 915
 916          Code : Char_Code;
 917          --  Current character code value
 918
 919          Err : Boolean;
 920          --  Error flag for Scan_Wide call
 921
 922          String_Start : Source_Ptr;
 923          --  Point to first character of string
 924
 925          procedure Error_Bad_String_Char;
 926          --  Signal bad character in string/character literal. On entry
 927          --  Scan_Ptr points to the improper character encountered during the
 928          --  scan. Scan_Ptr is not modified, so it still points to the bad
 929          --  character on return.
 930
 931          procedure Error_Unterminated_String;
 932          --  Procedure called if a line terminator character is encountered
 933          --  during scanning a string, meaning that the string is not properly
 934          --  terminated.
 935
 936          procedure Set_String;
 937          --  Procedure used to distinguish between string and operator symbol.
 938          --  On entry the string has been scanned out, and its characters start
 939          --  at Token_Ptr and end one character before Scan_Ptr. On exit Token
 940          --  is set to Tok_String_Literal/Tok_Operator_Symbol as appropriate,
 941          --  and Token_Node is appropriately initialized. In addition, in the
 942          --  operator symbol case, Token_Name is appropriately set, and the
 943          --  flags [Wide_]Wide_Character_Found are set appropriately.
 944
 945          ---------------------------
 946          -- Error_Bad_String_Char --
 947          ---------------------------
 948
 949          procedure Error_Bad_String_Char is
 950             C : constant Character := Source (Scan_Ptr);
 951
 952          begin
 953             if C = HT then
 954                Error_Msg_S ("horizontal tab not allowed in string");
 955
 956             elsif C = VT or else C = FF then
 957                Error_Msg_S ("format effector not allowed in string");
 958
 959             elsif C in Upper_Half_Character then
 960                Error_Msg_S ("(Ada 83) upper half character not allowed");
 961
 962             else
 963                Error_Msg_S ("control character not allowed in string");
 964             end if;
 965          end Error_Bad_String_Char;
 966
 967          -------------------------------
 968          -- Error_Unterminated_String --
 969          -------------------------------
 970
 971          procedure Error_Unterminated_String is
 972             S : Source_Ptr;
 973
 974          begin
 975             --  An interesting little refinement. Consider the following
 976             --  examples:
 977
 978             --     A := "this is an unterminated string;
 979             --     A := "this is an unterminated string &
 980             --     P(A, "this is a parameter that didn't get terminated);
 981             --     P("this is a parameter that didn't get terminated, A);
 982
 983             --  We fiddle a little to do slightly better placement in these
 984             --  cases also if there is white space at the end of the line we
 985             --  place the flag at the start of this white space, not at the
 986             --  end. Note that we only have to test for blanks, since tabs
 987             --  aren't allowed in strings in the first place and would have
 988             --  caused an error message.
 989
 990             --  Two more cases that we treat specially are:
 991
 992             --     A := "this string uses the wrong terminator'
 993             --     A := "this string uses the wrong terminator' &
 994
 995             --  In these cases we give a different error message as well
 996
 997             --  We actually reposition the scan pointer to the point where we
 998             --  place the flag in these cases, since it seems a better bet on
 999             --  the original intention.
1000
1001             while Source (Scan_Ptr - 1) = ' '
1002               or else Source (Scan_Ptr - 1) = '&'
1003             loop
1004                Scan_Ptr := Scan_Ptr - 1;
1005                Unstore_String_Char;
1006             end loop;
1007
1008             --  Check for case of incorrect string terminator, but single quote
1009             --  is not considered incorrect if the opening terminator misused
1010             --  a single quote (error message already given).
1011
1012             if Delimiter /= '''
1013               and then Source (Scan_Ptr - 1) = '''
1014             then
1015                Unstore_String_Char;
1016                Error_Msg
1017                  ("incorrect string terminator character", Scan_Ptr - 1);
1018                return;
1019             end if;
1020
1021             --  Backup over semicolon or right-paren/semicolon sequence
1022
1023             if Source (Scan_Ptr - 1) = ';' then
1024                Scan_Ptr := Scan_Ptr - 1;
1025                Unstore_String_Char;
1026
1027                if Source (Scan_Ptr - 1) = ')' then
1028                   Scan_Ptr := Scan_Ptr - 1;
1029                   Unstore_String_Char;
1030                end if;
1031             end if;
1032
1033             --  See if there is a comma in the string, if so, guess that
1034             --  the first comma terminates the string.
1035
1036             S := String_Start;
1037             while S < Scan_Ptr loop
1038                if Source (S) = ',' then
1039                   while Scan_Ptr > S loop
1040                      Scan_Ptr := Scan_Ptr - 1;
1041                      Unstore_String_Char;
1042                   end loop;
1043
1044                   exit;
1045                end if;
1046
1047                S := S + 1;
1048             end loop;
1049
1050             --  Now we have adjusted the scan pointer, give message
1051
1052             Error_Msg_S -- CODEFIX
1053               ("missing string quote");
1054          end Error_Unterminated_String;
1055
1056          ----------------
1057          -- Set_String --
1058          ----------------
1059
1060          procedure Set_String is
1061             Slen : constant Int := Int (Scan_Ptr - Token_Ptr - 2);
1062             C1   : Character;
1063             C2   : Character;
1064             C3   : Character;
1065
1066          begin
1067             --  Token_Name is currently set to Error_Name. The following
1068             --  section of code resets Token_Name to the proper Name_Op_xx
1069             --  value if the string is a valid operator symbol, otherwise it is
1070             --  left set to Error_Name.
1071
1072             if Slen = 1 then
1073                C1 := Source (Token_Ptr + 1);
1074
1075                case C1 is
1076                   when '=' =>
1077                      Token_Name := Name_Op_Eq;
1078
1079                   when '>' =>
1080                      Token_Name := Name_Op_Gt;
1081
1082                   when '<' =>
1083                      Token_Name := Name_Op_Lt;
1084
1085                   when '+' =>
1086                      Token_Name := Name_Op_Add;
1087
1088                   when '-' =>
1089                      Token_Name := Name_Op_Subtract;
1090
1091                   when '&' =>
1092                      Token_Name := Name_Op_Concat;
1093
1094                   when '*' =>
1095                      Token_Name := Name_Op_Multiply;
1096
1097                   when '/' =>
1098                      Token_Name := Name_Op_Divide;
1099
1100                   when others =>
1101                      null;
1102                end case;
1103
1104             elsif Slen = 2 then
1105                C1 := Source (Token_Ptr + 1);
1106                C2 := Source (Token_Ptr + 2);
1107
1108                if C1 = '*' and then C2 = '*' then
1109                   Token_Name := Name_Op_Expon;
1110
1111                elsif C2 = '=' then
1112
1113                   if C1 = '/' then
1114                      Token_Name := Name_Op_Ne;
1115                   elsif C1 = '<' then
1116                      Token_Name := Name_Op_Le;
1117                   elsif C1 = '>' then
1118                      Token_Name := Name_Op_Ge;
1119                   end if;
1120
1121                elsif (C1 = 'O' or else C1 = 'o') and then    -- OR
1122                  (C2 = 'R' or else C2 = 'r')
1123                then
1124                   Token_Name := Name_Op_Or;
1125                end if;
1126
1127             elsif Slen = 3 then
1128                C1 := Source (Token_Ptr + 1);
1129                C2 := Source (Token_Ptr + 2);
1130                C3 := Source (Token_Ptr + 3);
1131
1132                if (C1 = 'A' or else C1 = 'a') and then       -- AND
1133                  (C2 = 'N' or else C2 = 'n') and then
1134                  (C3 = 'D' or else C3 = 'd')
1135                then
1136                   Token_Name := Name_Op_And;
1137
1138                elsif (C1 = 'A' or else C1 = 'a') and then    -- ABS
1139                  (C2 = 'B' or else C2 = 'b') and then
1140                  (C3 = 'S' or else C3 = 's')
1141                then
1142                   Token_Name := Name_Op_Abs;
1143
1144                elsif (C1 = 'M' or else C1 = 'm') and then    -- MOD
1145                  (C2 = 'O' or else C2 = 'o') and then
1146                  (C3 = 'D' or else C3 = 'd')
1147                then
1148                   Token_Name := Name_Op_Mod;
1149
1150                elsif (C1 = 'N' or else C1 = 'n') and then    -- NOT
1151                  (C2 = 'O' or else C2 = 'o') and then
1152                  (C3 = 'T' or else C3 = 't')
1153                then
1154                   Token_Name := Name_Op_Not;
1155
1156                elsif (C1 = 'R' or else C1 = 'r') and then    -- REM
1157                  (C2 = 'E' or else C2 = 'e') and then
1158                  (C3 = 'M' or else C3 = 'm')
1159                then
1160                   Token_Name := Name_Op_Rem;
1161
1162                elsif (C1 = 'X' or else C1 = 'x') and then    -- XOR
1163                  (C2 = 'O' or else C2 = 'o') and then
1164                  (C3 = 'R' or else C3 = 'r')
1165                then
1166                   Token_Name := Name_Op_Xor;
1167                end if;
1168
1169             end if;
1170
1171             --  If it is an operator symbol, then Token_Name is set. If it is
1172             --  some other string value, then Token_Name still contains
1173             --  Error_Name.
1174
1175             if Token_Name = Error_Name then
1176                Token := Tok_String_Literal;
1177
1178             else
1179                Token := Tok_Operator_Symbol;
1180             end if;
1181          end Set_String;
1182
1183       --  Start of processing for Slit
1184
1185       begin
1186          --  On entry, Scan_Ptr points to the opening character of the string
1187          --  which is either a percent, double quote, or apostrophe (single
1188          --  quote). The latter case is an error detected by the character
1189          --  literal circuit.
1190
1191          String_Start := Scan_Ptr;
1192
1193          Delimiter := Source (Scan_Ptr);
1194          Accumulate_Checksum (Delimiter);
1195
1196          Start_String;
1197          Wide_Character_Found      := False;
1198          Wide_Wide_Character_Found := False;
1199          Scan_Ptr := Scan_Ptr + 1;
1200
1201          --  Loop to scan out characters of string literal
1202
1203          loop
1204             C := Source (Scan_Ptr);
1205
1206             if C = Delimiter then
1207                Accumulate_Checksum (C);
1208                Scan_Ptr := Scan_Ptr + 1;
1209                exit when Source (Scan_Ptr) /= Delimiter;
1210                Code := Get_Char_Code (C);
1211                Accumulate_Checksum (C);
1212                Scan_Ptr := Scan_Ptr + 1;
1213
1214             else
1215                if C = '"' and then Delimiter = '%' then
1216                   Error_Msg_S
1217                     ("quote not allowed in percent delimited string");
1218                   Code := Get_Char_Code (C);
1219                   Scan_Ptr := Scan_Ptr + 1;
1220
1221                elsif Start_Of_Wide_Character then
1222                   Wptr := Scan_Ptr;
1223                   Scan_Wide (Source, Scan_Ptr, Code, Err);
1224
1225                   if Err then
1226                      Error_Illegal_Wide_Character;
1227                      Code := Get_Char_Code (' ');
1228                   end if;
1229
1230                   Accumulate_Checksum (Code);
1231
1232                   --  In Ada 95 mode we allow any wide characters in a string
1233                   --  but in Ada 2005, the set of characters allowed has been
1234                   --  restricted to graphic characters.
1235
1236                   if Ada_Version >= Ada_2005
1237                     and then Is_UTF_32_Non_Graphic (UTF_32 (Code))
1238                   then
1239                      Error_Msg
1240                        ("(Ada 2005) non-graphic character not permitted " &
1241                         "in string literal", Wptr);
1242                   end if;
1243
1244                else
1245                   Accumulate_Checksum (C);
1246
1247                   if C not in Graphic_Character then
1248                      if C in Line_Terminator then
1249                         Error_Unterminated_String;
1250                         exit;
1251
1252                      elsif C in Upper_Half_Character then
1253                         if Ada_Version = Ada_83 then
1254                            Error_Bad_String_Char;
1255                         end if;
1256
1257                      else
1258                         Error_Bad_String_Char;
1259                      end if;
1260                   end if;
1261
1262                   Code := Get_Char_Code (C);
1263                   Scan_Ptr := Scan_Ptr + 1;
1264                end if;
1265             end if;
1266
1267             Store_String_Char (Code);
1268
1269             if not In_Character_Range (Code) then
1270                if In_Wide_Character_Range (Code) then
1271                   Wide_Character_Found := True;
1272                else
1273                   Wide_Wide_Character_Found := True;
1274                end if;
1275             end if;
1276          end loop;
1277
1278          String_Literal_Id := End_String;
1279          Set_String;
1280          return;
1281       end Slit;
1282
1283       ----------------------------------
1284       -- Skip_Other_Format_Characters --
1285       ----------------------------------
1286
1287       procedure Skip_Other_Format_Characters is
1288          P    : Source_Ptr;
1289          Code : Char_Code;
1290          Err  : Boolean;
1291
1292       begin
1293          while Start_Of_Wide_Character loop
1294             P := Scan_Ptr;
1295             Scan_Wide (Source, Scan_Ptr, Code, Err);
1296
1297             if not Is_UTF_32_Other (UTF_32 (Code)) then
1298                Scan_Ptr := P;
1299                return;
1300             end if;
1301          end loop;
1302       end Skip_Other_Format_Characters;
1303
1304       -----------------------------
1305       -- Start_Of_Wide_Character --
1306       -----------------------------
1307
1308       function Start_Of_Wide_Character return Boolean is
1309          C : constant Character := Source (Scan_Ptr);
1310
1311       begin
1312          --  ESC encoding method with ESC present
1313
1314          if C = ESC
1315            and then Wide_Character_Encoding_Method in WC_ESC_Encoding_Method
1316          then
1317             return True;
1318
1319          --  Upper half character with upper half encoding
1320
1321          elsif C in Upper_Half_Character and then Upper_Half_Encoding then
1322             return True;
1323
1324          --  Brackets encoding
1325
1326          elsif C = '['
1327            and then Source (Scan_Ptr + 1) = '"'
1328            and then Identifier_Char (Source (Scan_Ptr + 2))
1329          then
1330             return True;
1331
1332          --  Not the start of a wide character
1333
1334          else
1335             return False;
1336          end if;
1337       end Start_Of_Wide_Character;
1338
1339    --  Start of processing for Scan
1340
1341    begin
1342       Prev_Token := Token;
1343       Prev_Token_Ptr := Token_Ptr;
1344       Token_Name := Error_Name;
1345
1346       --  The following loop runs more than once only if a format effector
1347       --  (tab, vertical tab, form  feed, line feed, carriage return) is
1348       --  encountered and skipped, or some error situation, such as an
1349       --  illegal character, is encountered.
1350
1351       <<Scan_Next_Character>>
1352
1353       loop
1354          --  Skip past blanks, loop is opened up for speed
1355
1356          while Source (Scan_Ptr) = ' ' loop
1357             if Source (Scan_Ptr + 1) /= ' ' then
1358                Scan_Ptr := Scan_Ptr + 1;
1359                exit;
1360             end if;
1361
1362             if Source (Scan_Ptr + 2) /= ' ' then
1363                Scan_Ptr := Scan_Ptr + 2;
1364                exit;
1365             end if;
1366
1367             if Source (Scan_Ptr + 3) /= ' ' then
1368                Scan_Ptr := Scan_Ptr + 3;
1369                exit;
1370             end if;
1371
1372             if Source (Scan_Ptr + 4) /= ' ' then
1373                Scan_Ptr := Scan_Ptr + 4;
1374                exit;
1375             end if;
1376
1377             if Source (Scan_Ptr + 5) /= ' ' then
1378                Scan_Ptr := Scan_Ptr + 5;
1379                exit;
1380             end if;
1381
1382             if Source (Scan_Ptr + 6) /= ' ' then
1383                Scan_Ptr := Scan_Ptr + 6;
1384                exit;
1385             end if;
1386
1387             if Source (Scan_Ptr + 7) /= ' ' then
1388                Scan_Ptr := Scan_Ptr + 7;
1389                exit;
1390             end if;
1391
1392             Scan_Ptr := Scan_Ptr + 8;
1393          end loop;
1394
1395          --  We are now at a non-blank character, which is the first character
1396          --  of the token we will scan, and hence the value of Token_Ptr.
1397
1398          Token_Ptr := Scan_Ptr;
1399
1400          --  Here begins the main case statement which transfers control on the
1401          --  basis of the non-blank character we have encountered.
1402
1403          case Source (Scan_Ptr) is
1404
1405          --  Line terminator characters
1406
1407          when CR | LF | FF | VT =>
1408             goto Scan_Line_Terminator;
1409
1410          --  Horizontal tab, just skip past it
1411
1412          when HT =>
1413             if Style_Check then
1414                Style.Check_HT;
1415             end if;
1416
1417             Scan_Ptr := Scan_Ptr + 1;
1418
1419          --  End of file character, treated as an end of file only if it is
1420          --  the last character in the buffer, otherwise it is ignored.
1421
1422          when EOF =>
1423             if Scan_Ptr = Source_Last (Current_Source_File) then
1424                Check_End_Of_Line;
1425
1426                if Style_Check then
1427                   Style.Check_EOF;
1428                end if;
1429
1430                Token := Tok_EOF;
1431                return;
1432             else
1433                Scan_Ptr := Scan_Ptr + 1;
1434             end if;
1435
1436          --  Ampersand
1437
1438          when '&' =>
1439             Accumulate_Checksum ('&');
1440
1441             if Source (Scan_Ptr + 1) = '&' then
1442                Error_Msg_S -- CODEFIX
1443                  ("'&'& should be `AND THEN`");
1444                Scan_Ptr := Scan_Ptr + 2;
1445                Token := Tok_And;
1446                return;
1447
1448             else
1449                Scan_Ptr := Scan_Ptr + 1;
1450                Token := Tok_Ampersand;
1451                return;
1452             end if;
1453
1454          --  Asterisk (can be multiplication operator or double asterisk which
1455          --  is the exponentiation compound delimiter).
1456
1457          when '*' =>
1458             Accumulate_Checksum ('*');
1459
1460             if Source (Scan_Ptr + 1) = '*' then
1461                Accumulate_Checksum ('*');
1462                Scan_Ptr := Scan_Ptr + 2;
1463                Token := Tok_Double_Asterisk;
1464                return;
1465
1466             else
1467                Scan_Ptr := Scan_Ptr + 1;
1468                Token := Tok_Asterisk;
1469                return;
1470             end if;
1471
1472          --  Colon, which can either be an isolated colon, or part of an
1473          --  assignment compound delimiter.
1474
1475          when ':' =>
1476             Accumulate_Checksum (':');
1477
1478             if Double_Char_Token ('=') then
1479                Token := Tok_Colon_Equal;
1480
1481                if Style_Check then
1482                   Style.Check_Colon_Equal;
1483                end if;
1484
1485                return;
1486
1487             elsif Source (Scan_Ptr + 1) = '-'
1488               and then Source (Scan_Ptr + 2) /= '-'
1489             then
1490                Token := Tok_Colon_Equal;
1491                Error_Msg -- CODEFIX
1492                  (":- should be :=", Scan_Ptr);
1493                Scan_Ptr := Scan_Ptr + 2;
1494                return;
1495
1496             else
1497                Scan_Ptr := Scan_Ptr + 1;
1498                Token := Tok_Colon;
1499
1500                if Style_Check then
1501                   Style.Check_Colon;
1502                end if;
1503
1504                return;
1505             end if;
1506
1507          --  Left parenthesis
1508
1509          when '(' =>
1510             Accumulate_Checksum ('(');
1511             Scan_Ptr := Scan_Ptr + 1;
1512             Token := Tok_Left_Paren;
1513
1514             if Style_Check then
1515                Style.Check_Left_Paren;
1516             end if;
1517
1518             return;
1519
1520          --  Left bracket
1521
1522          when '[' =>
1523             if Source (Scan_Ptr + 1) = '"' then
1524                goto Scan_Wide_Character;
1525
1526             else
1527                Error_Msg_S ("illegal character, replaced by ""(""");
1528                Scan_Ptr := Scan_Ptr + 1;
1529                Token := Tok_Left_Paren;
1530                return;
1531             end if;
1532
1533          --  Left brace
1534
1535          when '{' =>
1536             Error_Msg_S ("illegal character, replaced by ""(""");
1537             Scan_Ptr := Scan_Ptr + 1;
1538             Token := Tok_Left_Paren;
1539             return;
1540
1541          --  Comma
1542
1543          when ',' =>
1544             Accumulate_Checksum (',');
1545             Scan_Ptr := Scan_Ptr + 1;
1546             Token := Tok_Comma;
1547
1548             if Style_Check then
1549                Style.Check_Comma;
1550             end if;
1551
1552             return;
1553
1554          --  Dot, which is either an isolated period, or part of a double dot
1555          --  compound delimiter sequence. We also check for the case of a
1556          --  digit following the period, to give a better error message.
1557
1558          when '.' =>
1559             Accumulate_Checksum ('.');
1560
1561             if Double_Char_Token ('.') then
1562                Token := Tok_Dot_Dot;
1563
1564                if Style_Check then
1565                   Style.Check_Dot_Dot;
1566                end if;
1567
1568                return;
1569
1570             elsif Source (Scan_Ptr + 1) in '0' .. '9' then
1571                Error_Msg_S ("numeric literal cannot start with point");
1572                Scan_Ptr := Scan_Ptr + 1;
1573
1574             else
1575                Scan_Ptr := Scan_Ptr + 1;
1576                Token := Tok_Dot;
1577                return;
1578             end if;
1579
1580          --  Equal, which can either be an equality operator, or part of the
1581          --  arrow (=>) compound delimiter.
1582
1583          when '=' =>
1584             Accumulate_Checksum ('=');
1585
1586             if Double_Char_Token ('>') then
1587                Token := Tok_Arrow;
1588
1589                if Style_Check then
1590                   Style.Check_Arrow;
1591                end if;
1592
1593                return;
1594
1595             elsif Source (Scan_Ptr + 1) = '=' then
1596                Error_Msg_S -- CODEFIX
1597                  ("== should be =");
1598                Scan_Ptr := Scan_Ptr + 1;
1599             end if;
1600
1601             Scan_Ptr := Scan_Ptr + 1;
1602             Token := Tok_Equal;
1603             return;
1604
1605          --  Greater than, which can be a greater than operator, greater than
1606          --  or equal operator, or first character of a right label bracket.
1607
1608          when '>' =>
1609             Accumulate_Checksum ('>');
1610
1611             if Double_Char_Token ('=') then
1612                Token := Tok_Greater_Equal;
1613                return;
1614
1615             elsif Double_Char_Token ('>') then
1616                Token := Tok_Greater_Greater;
1617                return;
1618
1619             else
1620                Scan_Ptr := Scan_Ptr + 1;
1621                Token := Tok_Greater;
1622                return;
1623             end if;
1624
1625          --  Less than, which can be a less than operator, less than or equal
1626          --  operator, or the first character of a left label bracket, or the
1627          --  first character of a box (<>) compound delimiter.
1628
1629          when '<' =>
1630             Accumulate_Checksum ('<');
1631
1632             if Double_Char_Token ('=') then
1633                Token := Tok_Less_Equal;
1634                return;
1635
1636             elsif Double_Char_Token ('>') then
1637                Token := Tok_Box;
1638
1639                if Style_Check then
1640                   Style.Check_Box;
1641                end if;
1642
1643                return;
1644
1645             elsif Double_Char_Token ('<') then
1646                Token := Tok_Less_Less;
1647                return;
1648
1649             else
1650                Scan_Ptr := Scan_Ptr + 1;
1651                Token := Tok_Less;
1652                return;
1653             end if;
1654
1655          --  Minus, which is either a subtraction operator, or the first
1656          --  character of double minus starting a comment
1657
1658          when '-' => Minus_Case : begin
1659             if Source (Scan_Ptr + 1) = '>' then
1660                Error_Msg_S ("invalid token");
1661                Scan_Ptr := Scan_Ptr + 2;
1662                Token := Tok_Arrow;
1663                return;
1664
1665             elsif Source (Scan_Ptr + 1) /= '-' then
1666                Accumulate_Checksum ('-');
1667                Scan_Ptr := Scan_Ptr + 1;
1668                Token := Tok_Minus;
1669                return;
1670
1671             --  Comment
1672
1673             else -- Source (Scan_Ptr + 1) = '-' then
1674                if Style_Check then
1675                   Style.Check_Comment;
1676                end if;
1677
1678                Scan_Ptr := Scan_Ptr + 2;
1679
1680                --  If we are in preprocessor mode with Replace_In_Comments set,
1681                --  then we return the "--" as a token on its own.
1682
1683                if Replace_In_Comments then
1684                   Token := Tok_Comment;
1685                   return;
1686                end if;
1687
1688                --  Otherwise scan out the comment
1689
1690                Start_Of_Comment := Scan_Ptr;
1691
1692                --  Loop to scan comment (this loop runs more than once only if
1693                --  a horizontal tab or other non-graphic character is scanned)
1694
1695                loop
1696                   --  Scan to non graphic character (opened up for speed)
1697
1698                   --  Note that we just eat left brackets, which means that
1699                   --  bracket notation cannot be used for end of line
1700                   --  characters in comments. This seems a reasonable choice,
1701                   --  since no one would ever use brackets notation in a real
1702                   --  program in this situation, and if we allow brackets
1703                   --  notation, we forbid some valid comments which contain a
1704                   --  brackets sequence that happens to match an end of line
1705                   --  character.
1706
1707                   loop
1708                      exit when Source (Scan_Ptr) not in Graphic_Character;
1709                      Scan_Ptr := Scan_Ptr + 1;
1710                      exit when Source (Scan_Ptr) not in Graphic_Character;
1711                      Scan_Ptr := Scan_Ptr + 1;
1712                      exit when Source (Scan_Ptr) not in Graphic_Character;
1713                      Scan_Ptr := Scan_Ptr + 1;
1714                      exit when Source (Scan_Ptr) not in Graphic_Character;
1715                      Scan_Ptr := Scan_Ptr + 1;
1716                      exit when Source (Scan_Ptr) not in Graphic_Character;
1717                      Scan_Ptr := Scan_Ptr + 1;
1718                   end loop;
1719
1720                   --  Keep going if horizontal tab
1721
1722                   if Source (Scan_Ptr) = HT then
1723                      if Style_Check then
1724                         Style.Check_HT;
1725                      end if;
1726
1727                      Scan_Ptr := Scan_Ptr + 1;
1728
1729                   --  Terminate scan of comment if line terminator
1730
1731                   elsif Source (Scan_Ptr) in Line_Terminator then
1732                      exit;
1733
1734                   --  Terminate scan of comment if end of file encountered
1735                   --  (embedded EOF character or real last character in file)
1736
1737                   elsif Source (Scan_Ptr) = EOF then
1738                      exit;
1739
1740                   --  If we have a wide character, we have to scan it out,
1741                   --  because it might be a legitimate line terminator
1742
1743                   elsif Start_Of_Wide_Character then
1744                      declare
1745                         Wptr : constant Source_Ptr := Scan_Ptr;
1746                         Code : Char_Code;
1747                         Err  : Boolean;
1748
1749                      begin
1750                         Scan_Wide (Source, Scan_Ptr, Code, Err);
1751
1752                         --  If not well formed wide character, then just skip
1753                         --  past it and ignore it.
1754
1755                         if Err then
1756                            Scan_Ptr := Wptr + 1;
1757
1758                         --  If UTF_32 terminator, terminate comment scan
1759
1760                         elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then
1761                            Scan_Ptr := Wptr;
1762                            exit;
1763                         end if;
1764                      end;
1765
1766                   --  Keep going if character in 80-FF range, or is ESC. These
1767                   --  characters are allowed in comments by RM-2.1(1), 2.7(2).
1768                   --  They are allowed even in Ada 83 mode according to the
1769                   --  approved AI. ESC was added to the AI in June 93.
1770
1771                   elsif Source (Scan_Ptr) in Upper_Half_Character
1772                      or else Source (Scan_Ptr) = ESC
1773                   then
1774                      Scan_Ptr := Scan_Ptr + 1;
1775
1776                   --  Otherwise we have an illegal comment character
1777
1778                   else
1779                      Error_Illegal_Character;
1780                   end if;
1781                end loop;
1782
1783                --  Note that, except when comments are tokens, we do NOT
1784                --  execute a return here, instead we fall through to reexecute
1785                --  the scan loop to look for a token.
1786
1787                if Comment_Is_Token then
1788                   Name_Len := Integer (Scan_Ptr - Start_Of_Comment);
1789                   Name_Buffer (1 .. Name_Len) :=
1790                     String (Source (Start_Of_Comment .. Scan_Ptr - 1));
1791                   Comment_Id := Name_Find;
1792                   Token := Tok_Comment;
1793                   return;
1794                end if;
1795
1796                --  If the SPARK restriction is set for this unit, then generate
1797                --  a token Tok_SPARK_Hide for a SPARK HIDE directive.
1798
1799                if Restriction_Check_Required (SPARK)
1800                  and then Source (Start_Of_Comment) = '#'
1801                then
1802                   declare
1803                      Scan_SPARK_Ptr : Source_Ptr;
1804
1805                   begin
1806                      Scan_SPARK_Ptr := Start_Of_Comment + 1;
1807
1808                      --  Scan out blanks
1809
1810                      while Source (Scan_SPARK_Ptr) = ' '
1811                        or else Source (Scan_SPARK_Ptr) = HT
1812                      loop
1813                         Scan_SPARK_Ptr := Scan_SPARK_Ptr + 1;
1814                      end loop;
1815
1816                      --  Recognize HIDE directive. SPARK input cannot be
1817                      --  encoded as wide characters, so only deal with
1818                      --  lower/upper case.
1819
1820                      if (Source (Scan_SPARK_Ptr) = 'h'
1821                           or else Source (Scan_SPARK_Ptr) = 'H')
1822                        and then (Source (Scan_SPARK_Ptr + 1) = 'i'
1823                                   or else Source (Scan_SPARK_Ptr + 1) = 'I')
1824                        and then (Source (Scan_SPARK_Ptr + 2) = 'd'
1825                                   or else Source (Scan_SPARK_Ptr + 2) = 'D')
1826                        and then (Source (Scan_SPARK_Ptr + 3) = 'e'
1827                                   or else Source (Scan_SPARK_Ptr + 3) = 'E')
1828                        and then (Source (Scan_SPARK_Ptr + 4) = ' '
1829                                   or else Source (Scan_SPARK_Ptr + 4) = HT)
1830                      then
1831                         Token := Tok_SPARK_Hide;
1832                         return;
1833                      end if;
1834                   end;
1835                end if;
1836             end if;
1837          end Minus_Case;
1838
1839          --  Double quote or percent starting a string literal
1840
1841          when '"' | '%' =>
1842             Slit;
1843             Post_Scan;
1844             return;
1845
1846          --  Apostrophe. This can either be the start of a character literal,
1847          --  or an isolated apostrophe used in a qualified expression or an
1848          --  attribute. We treat it as a character literal if it does not
1849          --  follow a right parenthesis, identifier, the keyword ALL or
1850          --  a literal. This means that we correctly treat constructs like:
1851
1852          --    A := CHARACTER'('A');
1853
1854          --  Note that RM-2.2(7) does not require a separator between
1855          --  "CHARACTER" and "'" in the above.
1856
1857          when ''' => Char_Literal_Case : declare
1858             Code : Char_Code;
1859             Err  : Boolean;
1860
1861          begin
1862             Accumulate_Checksum (''');
1863             Scan_Ptr := Scan_Ptr + 1;
1864
1865             --  Here is where we make the test to distinguish the cases. Treat
1866             --  as apostrophe if previous token is an identifier, right paren
1867             --  or the reserved word "all" (latter case as in A.all'Address)
1868             --  (or the reserved word "project" in project files). Also treat
1869             --  it as apostrophe after a literal (this catches some legitimate
1870             --  cases, like A."abs"'Address, and also gives better error
1871             --  behavior for impossible cases like 123'xxx).
1872
1873             if Prev_Token = Tok_Identifier
1874                or else Prev_Token = Tok_Right_Paren
1875                or else Prev_Token = Tok_All
1876                or else Prev_Token = Tok_Project
1877                or else Prev_Token in Token_Class_Literal
1878             then
1879                Token := Tok_Apostrophe;
1880
1881                if Style_Check then
1882                   Style.Check_Apostrophe;
1883                end if;
1884
1885                return;
1886
1887             --  Otherwise the apostrophe starts a character literal
1888
1889             else
1890                --  Case of wide character literal
1891
1892                if Start_Of_Wide_Character then
1893                   Wptr := Scan_Ptr;
1894                   Scan_Wide (Source, Scan_Ptr, Code, Err);
1895                   Accumulate_Checksum (Code);
1896
1897                   if Err then
1898                      Error_Illegal_Wide_Character;
1899                      Code := Character'Pos (' ');
1900
1901                   --  In Ada 95 mode we allow any wide character in a character
1902                   --  literal, but in Ada 2005, the set of characters allowed
1903                   --  is restricted to graphic characters.
1904
1905                   elsif Ada_Version >= Ada_2005
1906                     and then Is_UTF_32_Non_Graphic (UTF_32 (Code))
1907                   then
1908                      Error_Msg -- CODEFIX????
1909                        ("(Ada 2005) non-graphic character not permitted " &
1910                         "in character literal", Wptr);
1911                   end if;
1912
1913                   if Source (Scan_Ptr) /= ''' then
1914                         Error_Msg_S ("missing apostrophe");
1915                   else
1916                      Scan_Ptr := Scan_Ptr + 1;
1917                   end if;
1918
1919                --  If we do not find a closing quote in the expected place then
1920                --  assume that we have a misguided attempt at a string literal.
1921
1922                --  However, if previous token is RANGE, then we return an
1923                --  apostrophe instead since this gives better error recovery
1924
1925                elsif Source (Scan_Ptr + 1) /= ''' then
1926                   if Prev_Token = Tok_Range then
1927                      Token := Tok_Apostrophe;
1928                      return;
1929
1930                   else
1931                      Scan_Ptr := Scan_Ptr - 1;
1932                      Error_Msg_S
1933                        ("strings are delimited by double quote character");
1934                      Slit;
1935                      Post_Scan;
1936                      return;
1937                   end if;
1938
1939                --  Otherwise we have a (non-wide) character literal
1940
1941                else
1942                   Accumulate_Checksum (Source (Scan_Ptr));
1943
1944                   if Source (Scan_Ptr) not in Graphic_Character then
1945                      if Source (Scan_Ptr) in Upper_Half_Character then
1946                         if Ada_Version = Ada_83 then
1947                            Error_Illegal_Character;
1948                         end if;
1949
1950                      else
1951                         Error_Illegal_Character;
1952                      end if;
1953                   end if;
1954
1955                   Code := Get_Char_Code (Source (Scan_Ptr));
1956                   Scan_Ptr := Scan_Ptr + 2;
1957                end if;
1958
1959                --  Fall through here with Scan_Ptr updated past the closing
1960                --  quote, and Code set to the Char_Code value for the literal
1961
1962                Accumulate_Checksum (''');
1963                Token := Tok_Char_Literal;
1964                Set_Character_Literal_Name (Code);
1965                Token_Name := Name_Find;
1966                Character_Code := Code;
1967                Post_Scan;
1968                return;
1969             end if;
1970          end Char_Literal_Case;
1971
1972          --  Right parenthesis
1973
1974          when ')' =>
1975             Accumulate_Checksum (')');
1976             Scan_Ptr := Scan_Ptr + 1;
1977             Token := Tok_Right_Paren;
1978
1979             if Style_Check then
1980                Style.Check_Right_Paren;
1981             end if;
1982
1983             return;
1984
1985          --  Right bracket or right brace, treated as right paren
1986
1987          when ']' | '}' =>
1988             Error_Msg_S ("illegal character, replaced by "")""");
1989             Scan_Ptr := Scan_Ptr + 1;
1990             Token := Tok_Right_Paren;
1991             return;
1992
1993          --  Slash (can be division operator or first character of not equal)
1994
1995          when '/' =>
1996             Accumulate_Checksum ('/');
1997
1998             if Double_Char_Token ('=') then
1999                Token := Tok_Not_Equal;
2000                return;
2001             else
2002                Scan_Ptr := Scan_Ptr + 1;
2003                Token := Tok_Slash;
2004                return;
2005             end if;
2006
2007          --  Semicolon
2008
2009          when ';' =>
2010             Accumulate_Checksum (';');
2011             Scan_Ptr := Scan_Ptr + 1;
2012             Token := Tok_Semicolon;
2013
2014             if Style_Check then
2015                Style.Check_Semicolon;
2016             end if;
2017
2018             return;
2019
2020          --  Vertical bar
2021
2022          when '|' => Vertical_Bar_Case : begin
2023             Accumulate_Checksum ('|');
2024
2025             --  Special check for || to give nice message
2026
2027             if Source (Scan_Ptr + 1) = '|' then
2028                Error_Msg_S -- CODEFIX
2029                  ("""'|'|"" should be `OR ELSE`");
2030                Scan_Ptr := Scan_Ptr + 2;
2031                Token := Tok_Or;
2032                return;
2033
2034             else
2035                Scan_Ptr := Scan_Ptr + 1;
2036                Token := Tok_Vertical_Bar;
2037
2038                if Style_Check then
2039                   Style.Check_Vertical_Bar;
2040                end if;
2041
2042                Post_Scan;
2043                return;
2044             end if;
2045          end Vertical_Bar_Case;
2046
2047          --  Exclamation, replacement character for vertical bar
2048
2049          when '!' => Exclamation_Case : begin
2050             Accumulate_Checksum ('!');
2051
2052             if Source (Scan_Ptr + 1) = '=' then
2053                Error_Msg_S -- CODEFIX
2054                  ("'!= should be /=");
2055                Scan_Ptr := Scan_Ptr + 2;
2056                Token := Tok_Not_Equal;
2057                return;
2058
2059             else
2060                Scan_Ptr := Scan_Ptr + 1;
2061                Token := Tok_Vertical_Bar;
2062                Post_Scan;
2063                return;
2064             end if;
2065          end Exclamation_Case;
2066
2067          --  Plus
2068
2069          when '+' => Plus_Case : begin
2070             Accumulate_Checksum ('+');
2071             Scan_Ptr := Scan_Ptr + 1;
2072             Token := Tok_Plus;
2073             return;
2074          end Plus_Case;
2075
2076          --  Digits starting a numeric literal
2077
2078          when '0' .. '9' =>
2079
2080             --  First a bit of a scan ahead to see if we have a case of an
2081             --  identifier starting with a digit (remembering exponent case).
2082
2083             declare
2084                C : constant Character := Source (Scan_Ptr + 1);
2085
2086             begin
2087                --  OK literal if digit followed by digit or underscore
2088
2089                if C in '0' .. '9' or else C = '_' then
2090                   null;
2091
2092                --  OK literal if digit not followed by identifier char
2093
2094                elsif not Identifier_Char (C) then
2095                   null;
2096
2097                --  OK literal if digit followed by e/E followed by digit/sign.
2098                --  We also allow underscore after the E, which is an error, but
2099                --  better handled by Nlit than deciding this is an identifier.
2100
2101                elsif (C = 'e' or else C = 'E')
2102                  and then (Source (Scan_Ptr + 2) in '0' .. '9'
2103                              or else Source (Scan_Ptr + 2) = '+'
2104                              or else Source (Scan_Ptr + 2) = '-'
2105                              or else Source (Scan_Ptr + 2) = '_')
2106                then
2107                   null;
2108
2109                --  Here we have what really looks like an identifier that
2110                --  starts with a digit, so give error msg.
2111
2112                else
2113                   Error_Msg_S ("identifier may not start with digit");
2114                   Name_Len := 1;
2115                   Underline_Found := False;
2116                   Name_Buffer (1) := Source (Scan_Ptr);
2117                   Accumulate_Checksum (Name_Buffer (1));
2118                   Scan_Ptr := Scan_Ptr + 1;
2119                   goto Scan_Identifier;
2120                end if;
2121             end;
2122
2123             --  Here we have an OK integer literal
2124
2125             Nlit;
2126
2127             --  Check for proper delimiter, ignoring other format characters
2128
2129             Skip_Other_Format_Characters;
2130
2131             if Identifier_Char (Source (Scan_Ptr)) then
2132                Error_Msg_S
2133                  ("delimiter required between literal and identifier");
2134             end if;
2135
2136             Post_Scan;
2137             return;
2138
2139          --  Lower case letters
2140
2141          when 'a' .. 'z' =>
2142             Name_Len := 1;
2143             Underline_Found := False;
2144             Name_Buffer (1) := Source (Scan_Ptr);
2145             Accumulate_Checksum (Name_Buffer (1));
2146             Scan_Ptr := Scan_Ptr + 1;
2147             goto Scan_Identifier;
2148
2149          --  Upper case letters
2150
2151          when 'A' .. 'Z' =>
2152             Name_Len := 1;
2153             Underline_Found := False;
2154             Name_Buffer (1) :=
2155               Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
2156             Accumulate_Checksum (Name_Buffer (1));
2157             Scan_Ptr := Scan_Ptr + 1;
2158             goto Scan_Identifier;
2159
2160          --  Underline character
2161
2162          when '_' =>
2163             if Special_Characters ('_') then
2164                Token_Ptr := Scan_Ptr;
2165                Scan_Ptr := Scan_Ptr + 1;
2166                Token := Tok_Special;
2167                Special_Character := '_';
2168                return;
2169             end if;
2170
2171             Error_Msg_S ("identifier cannot start with underline");
2172             Name_Len := 1;
2173             Name_Buffer (1) := '_';
2174             Scan_Ptr := Scan_Ptr + 1;
2175             Underline_Found := False;
2176             goto Scan_Identifier;
2177
2178          --  Space (not possible, because we scanned past blanks)
2179
2180          when ' ' =>
2181             raise Program_Error;
2182
2183          --  Characters in top half of ASCII 8-bit chart
2184
2185          when Upper_Half_Character =>
2186
2187             --  Wide character case
2188
2189             if Upper_Half_Encoding then
2190                goto Scan_Wide_Character;
2191
2192             --  Otherwise we have OK Latin-1 character
2193
2194             else
2195                --  Upper half characters may possibly be identifier letters
2196                --  but can never be digits, so Identifier_Char can be used to
2197                --  test for a valid start of identifier character.
2198
2199                if Identifier_Char (Source (Scan_Ptr)) then
2200                   Name_Len := 0;
2201                   Underline_Found := False;
2202                   goto Scan_Identifier;
2203                else
2204                   Error_Illegal_Character;
2205                end if;
2206             end if;
2207
2208          when ESC =>
2209
2210             --  ESC character, possible start of identifier if wide characters
2211             --  using ESC encoding are allowed in identifiers, which we can
2212             --  tell by looking at the Identifier_Char flag for ESC, which is
2213             --  only true if these conditions are met. In Ada 2005 mode, may
2214             --  also be valid UTF_32 space or line terminator character.
2215
2216             if Identifier_Char (ESC) then
2217                Name_Len := 0;
2218                goto Scan_Wide_Character;
2219             else
2220                Error_Illegal_Character;
2221             end if;
2222
2223          --  Invalid control characters
2224
2225          when NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS  | ASCII.SO |
2226               SI  | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN |
2227               EM  | FS  | GS  | RS  | US  | DEL
2228          =>
2229             Error_Illegal_Character;
2230
2231          --  Invalid graphic characters
2232
2233          when '#' | '$' | '?' | '@' | '`' | '\' | '^' | '~' =>
2234
2235             --  If Set_Special_Character has been called for this character,
2236             --  set Scans.Special_Character and return a Special token.
2237
2238             if Special_Characters (Source (Scan_Ptr)) then
2239                Token_Ptr := Scan_Ptr;
2240                Token := Tok_Special;
2241                Special_Character := Source (Scan_Ptr);
2242                Scan_Ptr := Scan_Ptr + 1;
2243                return;
2244
2245             --  Otherwise, this is an illegal character
2246
2247             else
2248                Error_Illegal_Character;
2249             end if;
2250
2251          --  End switch on non-blank character
2252
2253          end case;
2254
2255       --  End loop past format effectors. The exit from this loop is by
2256       --  executing a return statement following completion of token scan
2257       --  (control never falls out of this loop to the code which follows)
2258
2259       end loop;
2260
2261       --  Wide_Character scanning routine. On entry we have encountered the
2262       --  initial character of a wide character sequence.
2263
2264       <<Scan_Wide_Character>>
2265
2266          declare
2267             Code : Char_Code;
2268             Cat  : Category;
2269             Err  : Boolean;
2270
2271          begin
2272             Wptr := Scan_Ptr;
2273             Scan_Wide (Source, Scan_Ptr, Code, Err);
2274
2275             --  If bad wide character, signal error and continue scan
2276
2277             if Err then
2278                Error_Illegal_Wide_Character;
2279                goto Scan_Next_Character;
2280             end if;
2281
2282             Cat := Get_Category (UTF_32 (Code));
2283
2284             --  If OK letter, reset scan ptr and go scan identifier
2285
2286             if Is_UTF_32_Letter (Cat) then
2287                Scan_Ptr := Wptr;
2288                Name_Len := 0;
2289                Underline_Found := False;
2290                goto Scan_Identifier;
2291
2292             --  If OK wide space, ignore and keep scanning (we do not include
2293             --  any ignored spaces in checksum)
2294
2295             elsif Is_UTF_32_Space (Cat) then
2296                goto Scan_Next_Character;
2297
2298             --  If other format character, ignore and keep scanning (again we
2299             --  do not include in the checksum) (this is for AI-0079).
2300
2301             elsif Is_UTF_32_Other (Cat) then
2302                goto Scan_Next_Character;
2303
2304             --  If OK wide line terminator, terminate current line
2305
2306             elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then
2307                Scan_Ptr := Wptr;
2308                goto Scan_Line_Terminator;
2309
2310             --  Punctuation is an error (at start of identifier)
2311
2312             elsif Is_UTF_32_Punctuation (Cat) then
2313                Error_Msg ("identifier cannot start with punctuation", Wptr);
2314                Scan_Ptr := Wptr;
2315                Name_Len := 0;
2316                Underline_Found := False;
2317                goto Scan_Identifier;
2318
2319             --  Mark character is an error (at start of identifier)
2320
2321             elsif Is_UTF_32_Mark (Cat) then
2322                Error_Msg ("identifier cannot start with mark character", Wptr);
2323                Scan_Ptr := Wptr;
2324                Name_Len := 0;
2325                Underline_Found := False;
2326                goto Scan_Identifier;
2327
2328             --  Extended digit character is an error. Could be bad start of
2329             --  identifier or bad literal. Not worth doing too much to try to
2330             --  distinguish these cases, but we will do a little bit.
2331
2332             elsif Is_UTF_32_Digit (Cat) then
2333                Error_Msg
2334                  ("identifier cannot start with digit character", Wptr);
2335                Scan_Ptr := Wptr;
2336                Name_Len := 0;
2337                Underline_Found := False;
2338                goto Scan_Identifier;
2339
2340             --  All other wide characters are illegal here
2341
2342             else
2343                Error_Illegal_Wide_Character;
2344                goto Scan_Next_Character;
2345             end if;
2346          end;
2347
2348       --  Routine to scan line terminator. On entry Scan_Ptr points to a
2349       --  character which is one of FF,LR,CR,VT, or one of the wide characters
2350       --  that is treated as a line terminator.
2351
2352       <<Scan_Line_Terminator>>
2353
2354          --  Check line too long
2355
2356          Check_End_Of_Line;
2357
2358          --  Set Token_Ptr, if End_Of_Line is a token, for the case when it is
2359          --  a physical line.
2360
2361          if End_Of_Line_Is_Token then
2362             Token_Ptr := Scan_Ptr;
2363          end if;
2364
2365          declare
2366             Physical : Boolean;
2367
2368          begin
2369             Skip_Line_Terminators (Scan_Ptr, Physical);
2370
2371             --  If we are at start of physical line, update scan pointers to
2372             --  reflect the start of the new line.
2373
2374             if Physical then
2375                Current_Line_Start       := Scan_Ptr;
2376                Start_Column             := Set_Start_Column;
2377                First_Non_Blank_Location := Scan_Ptr;
2378
2379                --  If End_Of_Line is a token, we return it as it is a
2380                --  physical line.
2381
2382                if End_Of_Line_Is_Token then
2383                   Token := Tok_End_Of_Line;
2384                   return;
2385                end if;
2386             end if;
2387          end;
2388
2389          goto Scan_Next_Character;
2390
2391       --  Identifier scanning routine. On entry, some initial characters of
2392       --  the identifier may have already been stored in Name_Buffer. If so,
2393       --  Name_Len has the number of characters stored, otherwise Name_Len is
2394       --  set to zero on entry. Underline_Found is also set False on entry.
2395
2396       <<Scan_Identifier>>
2397
2398          --  This loop scans as fast as possible past lower half letters and
2399          --  digits, which we expect to be the most common characters.
2400
2401          loop
2402             if Source (Scan_Ptr) in 'a' .. 'z'
2403               or else Source (Scan_Ptr) in '0' .. '9'
2404             then
2405                Name_Buffer (Name_Len + 1) := Source (Scan_Ptr);
2406                Accumulate_Checksum (Source (Scan_Ptr));
2407
2408             elsif Source (Scan_Ptr) in 'A' .. 'Z' then
2409                Name_Buffer (Name_Len + 1) :=
2410                  Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
2411                Accumulate_Checksum (Name_Buffer (Name_Len + 1));
2412
2413             else
2414                exit;
2415             end if;
2416
2417             Underline_Found := False;
2418             Scan_Ptr := Scan_Ptr + 1;
2419             Name_Len := Name_Len + 1;
2420          end loop;
2421
2422          --  If we fall through, then we have encountered either an underline
2423          --  character, or an extended identifier character (i.e. one from the
2424          --  upper half), or a wide character, or an identifier terminator. The
2425          --  initial test speeds us up in the most common case where we have
2426          --  an identifier terminator. Note that ESC is an identifier character
2427          --  only if a wide character encoding method that uses ESC encoding
2428          --  is active, so if we find an ESC character we know that we have a
2429          --  wide character.
2430
2431          if Identifier_Char (Source (Scan_Ptr))
2432            or else (Source (Scan_Ptr) in Upper_Half_Character
2433                      and then Upper_Half_Encoding)
2434          then
2435             --  Case of underline
2436
2437             if Source (Scan_Ptr) = '_' then
2438                Accumulate_Checksum ('_');
2439
2440                if Underline_Found then
2441                   Error_No_Double_Underline;
2442                else
2443                   Underline_Found := True;
2444                   Name_Len := Name_Len + 1;
2445                   Name_Buffer (Name_Len) := '_';
2446                end if;
2447
2448                Scan_Ptr := Scan_Ptr + 1;
2449                goto Scan_Identifier;
2450
2451             --  Upper half character
2452
2453             elsif Source (Scan_Ptr) in Upper_Half_Character
2454               and then not Upper_Half_Encoding
2455             then
2456                Accumulate_Checksum (Source (Scan_Ptr));
2457                Store_Encoded_Character
2458                  (Get_Char_Code (Fold_Lower (Source (Scan_Ptr))));
2459                Scan_Ptr := Scan_Ptr + 1;
2460                Underline_Found := False;
2461                goto Scan_Identifier;
2462
2463             --  Left bracket not followed by a quote terminates an identifier.
2464             --  This is an error, but we don't want to give a junk error msg
2465             --  about wide characters in this case!
2466
2467             elsif Source (Scan_Ptr) = '['
2468               and then Source (Scan_Ptr + 1) /= '"'
2469             then
2470                null;
2471
2472             --  We know we have a wide character encoding here (the current
2473             --  character is either ESC, left bracket, or an upper half
2474             --  character depending on the encoding method).
2475
2476             else
2477                --  Scan out the wide character and insert the appropriate
2478                --  encoding into the name table entry for the identifier.
2479
2480                declare
2481                   Code : Char_Code;
2482                   Err  : Boolean;
2483                   Chr  : Character;
2484                   Cat  : Category;
2485
2486                begin
2487                   Wptr := Scan_Ptr;
2488                   Scan_Wide (Source, Scan_Ptr, Code, Err);
2489
2490                   --  If error, signal error
2491
2492                   if Err then
2493                      Error_Illegal_Wide_Character;
2494
2495                   --  If the character scanned is a normal identifier
2496                   --  character, then we treat it that way.
2497
2498                   elsif In_Character_Range (Code)
2499                     and then Identifier_Char (Get_Character (Code))
2500                   then
2501                      Chr := Get_Character (Code);
2502                      Accumulate_Checksum (Chr);
2503                      Store_Encoded_Character
2504                        (Get_Char_Code (Fold_Lower (Chr)));
2505                      Underline_Found := False;
2506
2507                   --  Here if not a normal identifier character
2508
2509                   else
2510                      Cat := Get_Category (UTF_32 (Code));
2511
2512                      --  Wide character in Unicode category "Other, Format"
2513                      --  is not accepted in an identifier. This is because it
2514                      --  it is considered a security risk (AI-0091).
2515
2516                      --  However, it is OK for such a character to appear at
2517                      --  the end of an identifier.
2518
2519                      if Is_UTF_32_Other (Cat) then
2520                         if not Identifier_Char (Source (Scan_Ptr)) then
2521                            goto Scan_Identifier_Complete;
2522                         else
2523                            Error_Msg
2524                              ("identifier cannot contain other_format "
2525                               & "character", Wptr);
2526                            goto Scan_Identifier;
2527                         end if;
2528
2529                      --  Wide character in category Separator,Space terminates
2530
2531                      elsif Is_UTF_32_Space (Cat) then
2532                         goto Scan_Identifier_Complete;
2533                      end if;
2534
2535                      --  Here if wide character is part of the identifier
2536
2537                      --  Make sure we are allowing wide characters in
2538                      --  identifiers. Note that we allow wide character
2539                      --  notation for an OK identifier character. This in
2540                      --  particular allows bracket or other notation to be
2541                      --  used for upper half letters.
2542
2543                      --  Wide characters are always allowed in Ada 2005
2544
2545                      if Identifier_Character_Set /= 'w'
2546                        and then Ada_Version < Ada_2005
2547                      then
2548                         Error_Msg
2549                           ("wide character not allowed in identifier", Wptr);
2550                      end if;
2551
2552                      --  If OK letter, store it folding to upper case. Note
2553                      --  that we include the folded letter in the checksum.
2554
2555                      if Is_UTF_32_Letter (Cat) then
2556                         Code :=
2557                           Char_Code (UTF_32_To_Upper_Case (UTF_32 (Code)));
2558                         Accumulate_Checksum (Code);
2559                         Store_Encoded_Character (Code);
2560                         Underline_Found := False;
2561
2562                      --  If OK extended digit or mark, then store it
2563
2564                      elsif Is_UTF_32_Digit (Cat)
2565                        or else Is_UTF_32_Mark (Cat)
2566                      then
2567                         Accumulate_Checksum (Code);
2568                         Store_Encoded_Character (Code);
2569                         Underline_Found := False;
2570
2571                      --  Wide punctuation is also stored, but counts as an
2572                      --  underline character for error checking purposes.
2573
2574                      elsif Is_UTF_32_Punctuation (Cat) then
2575                         Accumulate_Checksum (Code);
2576
2577                         if Underline_Found then
2578                            declare
2579                               Cend : constant Source_Ptr := Scan_Ptr;
2580                            begin
2581                               Scan_Ptr := Wptr;
2582                               Error_No_Double_Underline;
2583                               Scan_Ptr := Cend;
2584                            end;
2585
2586                         else
2587                            Store_Encoded_Character (Code);
2588                            Underline_Found := True;
2589                         end if;
2590
2591                      --  Any other wide character is not acceptable
2592
2593                      else
2594                         Error_Msg
2595                           ("invalid wide character in identifier", Wptr);
2596                      end if;
2597                   end if;
2598
2599                   goto Scan_Identifier;
2600                end;
2601             end if;
2602          end if;
2603
2604       --  Scan of identifier is complete. The identifier is stored in
2605       --  Name_Buffer, and Scan_Ptr points past the last character.
2606
2607       <<Scan_Identifier_Complete>>
2608          Token_Name := Name_Find;
2609
2610          --  Check for identifier ending with underline or punctuation char
2611
2612          if Underline_Found then
2613             Underline_Found := False;
2614
2615             if Source (Scan_Ptr - 1) = '_' then
2616                Error_Msg
2617                  ("identifier cannot end with underline", Scan_Ptr - 1);
2618             else
2619                Error_Msg
2620                  ("identifier cannot end with punctuation character", Wptr);
2621             end if;
2622          end if;
2623
2624          --  We will assume it is an identifier, not a keyword, so that the
2625          --  checksum is independent of the Ada version.
2626
2627          Token := Tok_Identifier;
2628
2629          --  Here is where we check if it was a keyword
2630
2631          if Is_Keyword_Name (Token_Name) then
2632             if Opt.Checksum_GNAT_6_3 then
2633                Token := Token_Type'Val (Get_Name_Table_Byte (Token_Name));
2634
2635                if Checksum_Accumulate_Token_Checksum then
2636                   if Checksum_GNAT_5_03 then
2637                      Accumulate_Token_Checksum_GNAT_5_03;
2638                   else
2639                      Accumulate_Token_Checksum_GNAT_6_3;
2640                   end if;
2641                end if;
2642
2643             else
2644                Accumulate_Token_Checksum;
2645                Token := Token_Type'Val (Get_Name_Table_Byte (Token_Name));
2646             end if;
2647
2648             --  Keyword style checks
2649
2650             if Style_Check then
2651
2652                --  Deal with possible style check for non-lower case keyword,
2653                --  but we don't treat ACCESS, DELTA, DIGITS, RANGE as keywords
2654                --  for this purpose if they appear as attribute designators.
2655                --  Actually we only check the first character for speed.
2656
2657                --  Ada 2005 (AI-284): Do not apply the style check in case of
2658                --  "pragma Interface"
2659
2660                --  Ada 2005 (AI-340): Do not apply the style check in case of
2661                --  MOD attribute.
2662
2663                if Source (Token_Ptr) <= 'Z'
2664                  and then (Prev_Token /= Tok_Apostrophe
2665                            or else
2666                              (Token /= Tok_Access and then
2667                               Token /= Tok_Delta  and then
2668                               Token /= Tok_Digits and then
2669                               Token /= Tok_Mod    and then
2670                               Token /= Tok_Range))
2671                        and then (Token /= Tok_Interface
2672                                   or else
2673                                     (Token = Tok_Interface
2674                                       and then Prev_Token /= Tok_Pragma))
2675                then
2676                   Style.Non_Lower_Case_Keyword;
2677                end if;
2678
2679                --  Check THEN/ELSE style rules. These do not apply to AND THEN
2680                --  or OR ELSE, and do not apply in conditional expressions.
2681
2682                if (Token = Tok_Then and then Prev_Token /= Tok_And)
2683                     or else
2684                   (Token = Tok_Else and then Prev_Token /= Tok_Or)
2685                then
2686                   if Inside_Conditional_Expression = 0 then
2687                      Style.Check_Separate_Stmt_Lines;
2688                   end if;
2689                end if;
2690             end if;
2691
2692             --  We must reset Token_Name since this is not an identifier and
2693             --  if we leave Token_Name set, the parser gets confused because
2694             --  it thinks it is dealing with an identifier instead of the
2695             --  corresponding keyword.
2696
2697             Token_Name := No_Name;
2698             return;
2699
2700          --  It is an identifier after all
2701
2702          else
2703             if Checksum_Accumulate_Token_Checksum then
2704                Accumulate_Token_Checksum;
2705             end if;
2706
2707             Post_Scan;
2708             return;
2709          end if;
2710    end Scan;
2711
2712    --------------------------
2713    -- Set_Comment_As_Token --
2714    --------------------------
2715
2716    procedure Set_Comment_As_Token (Value : Boolean) is
2717    begin
2718       Comment_Is_Token := Value;
2719    end Set_Comment_As_Token;
2720
2721    ------------------------------
2722    -- Set_End_Of_Line_As_Token --
2723    ------------------------------
2724
2725    procedure Set_End_Of_Line_As_Token (Value : Boolean) is
2726    begin
2727       End_Of_Line_Is_Token := Value;
2728    end Set_End_Of_Line_As_Token;
2729
2730    ---------------------------
2731    -- Set_Special_Character --
2732    ---------------------------
2733
2734    procedure Set_Special_Character (C : Character) is
2735    begin
2736       case C is
2737          when '#' | '$' | '_' | '?' | '@' | '`' | '\' | '^' | '~' =>
2738             Special_Characters (C) := True;
2739
2740          when others =>
2741             null;
2742       end case;
2743    end Set_Special_Character;
2744
2745    ----------------------
2746    -- Set_Start_Column --
2747    ----------------------
2748
2749    --  Note: it seems at first glance a little expensive to compute this value
2750    --  for every source line (since it is certainly not used for all source
2751    --  lines). On the other hand, it doesn't take much more work to skip past
2752    --  the initial white space on the line counting the columns than it would
2753    --  to scan past the white space using the standard scanning circuits.
2754
2755    function Set_Start_Column return Column_Number is
2756       Start_Column : Column_Number := 0;
2757
2758    begin
2759       --  Outer loop scans past horizontal tab characters
2760
2761       Tabs_Loop : loop
2762
2763          --  Inner loop scans past blanks as fast as possible, bumping Scan_Ptr
2764          --  past the blanks and adjusting Start_Column to account for them.
2765
2766          Blanks_Loop : loop
2767             if Source (Scan_Ptr) = ' ' then
2768                if Source (Scan_Ptr + 1) = ' ' then
2769                   if Source (Scan_Ptr + 2) = ' ' then
2770                      if Source (Scan_Ptr + 3) = ' ' then
2771                         if Source (Scan_Ptr + 4) = ' ' then
2772                            if Source (Scan_Ptr + 5) = ' ' then
2773                               if Source (Scan_Ptr + 6) = ' ' then
2774                                  Scan_Ptr := Scan_Ptr + 7;
2775                                  Start_Column := Start_Column + 7;
2776                               else
2777                                  Scan_Ptr := Scan_Ptr + 6;
2778                                  Start_Column := Start_Column + 6;
2779                                  exit Blanks_Loop;
2780                               end if;
2781                            else
2782                               Scan_Ptr := Scan_Ptr + 5;
2783                               Start_Column := Start_Column + 5;
2784                               exit Blanks_Loop;
2785                            end if;
2786                         else
2787                            Scan_Ptr := Scan_Ptr + 4;
2788                            Start_Column := Start_Column + 4;
2789                            exit Blanks_Loop;
2790                         end if;
2791                      else
2792                         Scan_Ptr := Scan_Ptr + 3;
2793                         Start_Column := Start_Column + 3;
2794                         exit Blanks_Loop;
2795                      end if;
2796                   else
2797                      Scan_Ptr := Scan_Ptr + 2;
2798                      Start_Column := Start_Column + 2;
2799                      exit Blanks_Loop;
2800                   end if;
2801                else
2802                   Scan_Ptr := Scan_Ptr + 1;
2803                   Start_Column := Start_Column + 1;
2804                   exit Blanks_Loop;
2805                end if;
2806             else
2807                exit Blanks_Loop;
2808             end if;
2809          end loop Blanks_Loop;
2810
2811          --  Outer loop keeps going only if a horizontal tab follows
2812
2813          if Source (Scan_Ptr) = HT then
2814             if Style_Check then
2815                Style.Check_HT;
2816             end if;
2817
2818             Scan_Ptr := Scan_Ptr + 1;
2819             Start_Column := (Start_Column / 8) * 8 + 8;
2820          else
2821             exit Tabs_Loop;
2822          end if;
2823       end loop Tabs_Loop;
2824
2825       return Start_Column;
2826
2827    --  A constraint error can happen only if we have a compiler with checks on
2828    --  and a line with a ludicrous number of tabs or spaces at the start. In
2829    --  such a case, we really don't care if Start_Column is right or not.
2830
2831    exception
2832       when Constraint_Error =>
2833          return Start_Column;
2834    end Set_Start_Column;
2835
2836 end Scng;