1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Csets; use Csets;
27 with Err_Vars; use Err_Vars;
28 with Hostparm; use Hostparm;
29 with Namet; use Namet;
31 with Scans; use Scans;
32 with Sinput; use Sinput;
33 with Snames; use Snames;
34 with Stringt; use Stringt;
35 with Stylesw; use Stylesw;
36 with Uintp; use Uintp;
37 with Urealp; use Urealp;
38 with Widechar; use Widechar;
40 pragma Warnings (Off);
41 -- This package is used also by gnatcoll
43 with System.UTF_32; use System.UTF_32;
44 with System.WCh_Con; use System.WCh_Con;
50 -- Make control characters visible
52 Special_Characters : array (Character) of Boolean := (others => False);
53 -- For characters that are Special token, the value is True
55 Comment_Is_Token : Boolean := False;
56 -- True if comments are tokens
58 End_Of_Line_Is_Token : Boolean := False;
59 -- True if End_Of_Line is a token
61 -----------------------
62 -- Local Subprograms --
63 -----------------------
65 procedure Accumulate_Token_Checksum;
66 pragma Inline (Accumulate_Token_Checksum);
67 -- Called after each numeric literal and identifier/keyword. For keywords,
68 -- the token used is Tok_Identifier. This allows to detect additional
69 -- spaces added in sources when using the builder switch -m.
71 procedure Accumulate_Token_Checksum_GNAT_6_3;
72 -- Used in place of Accumulate_Token_Checksum for GNAT versions 5.04 to
73 -- 6.3, when Tok_Some was not included in Token_Type and the actual
74 -- Token_Type was used for keywords. This procedure is never used in the
75 -- compiler or gnatmake, only in gprbuild.
77 procedure Accumulate_Token_Checksum_GNAT_5_03;
78 -- Used in place of Accumulate_Token_Checksum for GNAT version 5.03, when
79 -- Tok_Interface, Tok_Some, Tok_Synchronized and Tok_Overriding were not
80 -- included in Token_Type and the actual Token_Type was used for keywords.
81 -- This procedure is never used in the compiler or gnatmake, only in
84 procedure Accumulate_Checksum (C : Character);
85 pragma Inline (Accumulate_Checksum);
86 -- This routine accumulates the checksum given character C. During the
87 -- scanning of a source file, this routine is called with every character
88 -- in the source, excluding blanks, and all control characters (except
89 -- that ESC is included in the checksum). Upper case letters not in string
90 -- literals are folded by the caller. See Sinput spec for the documentation
91 -- of the checksum algorithm. Note: checksum values are only used if we
92 -- generate code, so it is not necessary to worry about making the right
93 -- sequence of calls in any error situation.
95 procedure Accumulate_Checksum (C : Char_Code);
96 pragma Inline (Accumulate_Checksum);
97 -- This version is identical, except that the argument, C, is a character
98 -- code value instead of a character. This is used when wide characters
99 -- are scanned. We use the character code rather than the ASCII characters
100 -- so that the checksum is independent of wide character encoding method.
102 procedure Initialize_Checksum;
103 pragma Inline (Initialize_Checksum);
104 -- Initialize checksum value
106 -------------------------
107 -- Accumulate_Checksum --
108 -------------------------
110 procedure Accumulate_Checksum (C : Character) is
112 System.CRC32.Update (System.CRC32.CRC32 (Checksum), C);
113 end Accumulate_Checksum;
115 procedure Accumulate_Checksum (C : Char_Code) is
118 Accumulate_Checksum (Character'Val (C / 2 ** 24));
119 Accumulate_Checksum (Character'Val ((C / 2 ** 16) mod 256));
120 Accumulate_Checksum (Character'Val ((C / 256) mod 256));
122 Accumulate_Checksum (Character'Val (C / 256));
125 Accumulate_Checksum (Character'Val (C mod 256));
126 end Accumulate_Checksum;
128 -------------------------------
129 -- Accumulate_Token_Checksum --
130 -------------------------------
132 procedure Accumulate_Token_Checksum is
135 (System.CRC32.CRC32 (Checksum),
136 Character'Val (Token_Type'Pos (Token)));
137 end Accumulate_Token_Checksum;
139 ----------------------------------------
140 -- Accumulate_Token_Checksum_GNAT_6_3 --
141 ----------------------------------------
143 procedure Accumulate_Token_Checksum_GNAT_6_3 is
145 -- Individual values of Token_Type are used, instead of subranges, so
146 -- that additions or suppressions of enumerated values in type
147 -- Token_Type are detected by the compiler.
150 when Tok_Integer_Literal | Tok_Real_Literal | Tok_String_Literal |
151 Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier |
152 Tok_Double_Asterisk | Tok_Ampersand | Tok_Minus | Tok_Plus |
153 Tok_Asterisk | Tok_Mod | Tok_Rem | Tok_Slash | Tok_New |
154 Tok_Abs | Tok_Others | Tok_Null | Tok_Dot | Tok_Apostrophe |
155 Tok_Left_Paren | Tok_Delta | Tok_Digits | Tok_Range |
156 Tok_Right_Paren | Tok_Comma | Tok_And | Tok_Or | Tok_Xor |
157 Tok_Less | Tok_Equal | Tok_Greater | Tok_Not_Equal |
158 Tok_Greater_Equal | Tok_Less_Equal | Tok_In | Tok_Not |
159 Tok_Box | Tok_Colon_Equal | Tok_Colon | Tok_Greater_Greater |
160 Tok_Abstract | Tok_Access | Tok_Aliased | Tok_All | Tok_Array |
161 Tok_At | Tok_Body | Tok_Constant | Tok_Do | Tok_Is |
162 Tok_Interface | Tok_Limited | Tok_Of | Tok_Out | Tok_Record |
163 Tok_Renames | Tok_Reverse =>
166 (System.CRC32.CRC32 (Checksum),
167 Character'Val (Token_Type'Pos (Token)));
172 (System.CRC32.CRC32 (Checksum),
173 Character'Val (Token_Type'Pos (Tok_Identifier)));
175 when Tok_Tagged | Tok_Then | Tok_Less_Less | Tok_Abort | Tok_Accept |
176 Tok_Case | Tok_Delay | Tok_Else | Tok_Elsif | Tok_End |
177 Tok_Exception | Tok_Exit | Tok_Goto | Tok_If | Tok_Pragma |
178 Tok_Raise | Tok_Requeue | Tok_Return | Tok_Select |
179 Tok_Terminate | Tok_Until | Tok_When | Tok_Begin | Tok_Declare |
180 Tok_For | Tok_Loop | Tok_While | Tok_Entry | Tok_Protected |
181 Tok_Task | Tok_Type | Tok_Subtype | Tok_Overriding |
182 Tok_Synchronized | Tok_Use | Tok_Function | Tok_Generic |
183 Tok_Package | Tok_Procedure | Tok_Private | Tok_With |
184 Tok_Separate | Tok_EOF | Tok_Semicolon | Tok_Arrow |
185 Tok_Vertical_Bar | Tok_Dot_Dot | Tok_Project | Tok_Extends |
186 Tok_External | Tok_External_As_List | Tok_Comment |
187 Tok_End_Of_Line | Tok_Special | Tok_SPARK_Hide | No_Token =>
190 (System.CRC32.CRC32 (Checksum),
191 Character'Val (Token_Type'Pos (Token_Type'Pred (Token))));
193 end Accumulate_Token_Checksum_GNAT_6_3;
195 -----------------------------------------
196 -- Accumulate_Token_Checksum_GNAT_5_03 --
197 -----------------------------------------
199 procedure Accumulate_Token_Checksum_GNAT_5_03 is
201 -- Individual values of Token_Type are used, instead of subranges, so
202 -- that additions or suppressions of enumerated values in type
203 -- Token_Type are detected by the compiler.
206 when Tok_Integer_Literal | Tok_Real_Literal | Tok_String_Literal |
207 Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier |
208 Tok_Double_Asterisk | Tok_Ampersand | Tok_Minus | Tok_Plus |
209 Tok_Asterisk | Tok_Mod | Tok_Rem | Tok_Slash | Tok_New |
210 Tok_Abs | Tok_Others | Tok_Null | Tok_Dot | Tok_Apostrophe |
211 Tok_Left_Paren | Tok_Delta | Tok_Digits | Tok_Range |
212 Tok_Right_Paren | Tok_Comma | Tok_And | Tok_Or | Tok_Xor |
213 Tok_Less | Tok_Equal | Tok_Greater | Tok_Not_Equal |
214 Tok_Greater_Equal | Tok_Less_Equal | Tok_In | Tok_Not |
215 Tok_Box | Tok_Colon_Equal | Tok_Colon | Tok_Greater_Greater |
216 Tok_Abstract | Tok_Access | Tok_Aliased | Tok_All | Tok_Array |
217 Tok_At | Tok_Body | Tok_Constant | Tok_Do | Tok_Is =>
220 (System.CRC32.CRC32 (Checksum),
221 Character'Val (Token_Type'Pos (Token)));
223 when Tok_Interface | Tok_Some | Tok_Overriding | Tok_Synchronized =>
225 (System.CRC32.CRC32 (Checksum),
226 Character'Val (Token_Type'Pos (Tok_Identifier)));
228 when Tok_Limited | Tok_Of | Tok_Out | Tok_Record |
229 Tok_Renames | Tok_Reverse =>
232 (System.CRC32.CRC32 (Checksum),
233 Character'Val (Token_Type'Pos (Token) - 1));
235 when Tok_Tagged | Tok_Then | Tok_Less_Less | Tok_Abort | Tok_Accept |
236 Tok_Case | Tok_Delay | Tok_Else | Tok_Elsif | Tok_End |
237 Tok_Exception | Tok_Exit | Tok_Goto | Tok_If | Tok_Pragma |
238 Tok_Raise | Tok_Requeue | Tok_Return | Tok_Select |
239 Tok_Terminate | Tok_Until | Tok_When | Tok_Begin | Tok_Declare |
240 Tok_For | Tok_Loop | Tok_While | Tok_Entry | Tok_Protected |
241 Tok_Task | Tok_Type | Tok_Subtype =>
244 (System.CRC32.CRC32 (Checksum),
245 Character'Val (Token_Type'Pos (Token) - 2));
247 when Tok_Use | Tok_Function | Tok_Generic |
248 Tok_Package | Tok_Procedure | Tok_Private | Tok_With |
249 Tok_Separate | Tok_EOF | Tok_Semicolon | Tok_Arrow |
250 Tok_Vertical_Bar | Tok_Dot_Dot | Tok_Project | Tok_Extends |
251 Tok_External | Tok_External_As_List | Tok_Comment |
252 Tok_End_Of_Line | Tok_Special | Tok_SPARK_Hide | No_Token =>
255 (System.CRC32.CRC32 (Checksum),
256 Character'Val (Token_Type'Pos (Token) - 4));
258 end Accumulate_Token_Checksum_GNAT_5_03;
260 ----------------------------
261 -- Determine_Token_Casing --
262 ----------------------------
264 function Determine_Token_Casing return Casing_Type is
266 return Determine_Casing (Source (Token_Ptr .. Scan_Ptr - 1));
267 end Determine_Token_Casing;
269 -------------------------
270 -- Initialize_Checksum --
271 -------------------------
273 procedure Initialize_Checksum is
275 System.CRC32.Initialize (System.CRC32.CRC32 (Checksum));
276 end Initialize_Checksum;
278 ------------------------
279 -- Initialize_Scanner --
280 ------------------------
282 procedure Initialize_Scanner (Index : Source_File_Index) is
284 -- Establish reserved words
286 Scans.Initialize_Ada_Keywords;
288 -- Initialize scan control variables
290 Current_Source_File := Index;
291 Source := Source_Text (Current_Source_File);
292 Scan_Ptr := Source_First (Current_Source_File);
294 Token_Ptr := Scan_Ptr;
295 Current_Line_Start := Scan_Ptr;
297 Token_Name := No_Name;
298 Start_Column := Set_Start_Column;
299 First_Non_Blank_Location := Scan_Ptr;
302 Wide_Char_Byte_Count := 0;
304 -- Do not call Scan, otherwise the License stuff does not work in Scn
306 end Initialize_Scanner;
308 ------------------------------
309 -- Reset_Special_Characters --
310 ------------------------------
312 procedure Reset_Special_Characters is
314 Special_Characters := (others => False);
315 end Reset_Special_Characters;
323 Start_Of_Comment : Source_Ptr;
324 -- Record start of comment position
326 Underline_Found : Boolean;
327 -- During scanning of an identifier, set to True if last character
328 -- scanned was an underline or other punctuation character. This
329 -- is used to flag the error of two underlines/punctuations in a
330 -- row or ending an identifier with a underline/punctuation. Here
331 -- punctuation means any UTF_32 character in the Unicode category
332 -- Punctuation,Connector.
335 -- Used to remember start of last wide character scanned
337 procedure Check_End_Of_Line;
338 -- Called when end of line encountered. Checks that line is not too
339 -- long, and that other style checks for the end of line are met.
341 function Double_Char_Token (C : Character) return Boolean;
342 -- This function is used for double character tokens like := or <>. It
343 -- checks if the character following Source (Scan_Ptr) is C, and if so
344 -- bumps Scan_Ptr past the pair of characters and returns True. A space
345 -- between the two characters is also recognized with an appropriate
346 -- error message being issued. If C is not present, False is returned.
347 -- Note that Double_Char_Token can only be used for tokens defined in
348 -- the Ada syntax (it's use for error cases like && is not appropriate
349 -- since we do not want a junk message for a case like &-space-&).
351 procedure Error_Illegal_Character;
352 -- Give illegal character error, Scan_Ptr points to character. On
353 -- return, Scan_Ptr is bumped past the illegal character.
355 procedure Error_Illegal_Wide_Character;
356 -- Give illegal wide character message. On return, Scan_Ptr is bumped
357 -- past the illegal character, which may still leave us pointing to
358 -- junk, not much we can do if the escape sequence is messed up!
360 procedure Error_Long_Line;
361 -- Signal error of excessively long line
363 procedure Error_No_Double_Underline;
364 -- Signal error of two underline or punctuation characters in a row.
365 -- Called with Scan_Ptr pointing to second underline/punctuation char.
368 -- This is the procedure for scanning out numeric literals. On entry,
369 -- Scan_Ptr points to the digit that starts the numeric literal (the
370 -- checksum for this character has not been accumulated yet). On return
371 -- Scan_Ptr points past the last character of the numeric literal, Token
372 -- and Token_Node are set appropriately, and the checksum is updated.
375 -- This is the procedure for scanning out string literals. On entry,
376 -- Scan_Ptr points to the opening string quote (the checksum for this
377 -- character has not been accumulated yet). On return Scan_Ptr points
378 -- past the closing quote of the string literal, Token and Token_Node
379 -- are set appropriately, and the checksum is updated.
381 procedure Skip_Other_Format_Characters;
382 -- Skips past any "other format" category characters at the current
383 -- cursor location (does not skip past spaces or any other characters).
385 function Start_Of_Wide_Character return Boolean;
386 -- Returns True if the scan pointer is pointing to the start of a wide
387 -- character sequence, does not modify the scan pointer in any case.
389 -----------------------
390 -- Check_End_Of_Line --
391 -----------------------
393 procedure Check_End_Of_Line is
394 Len : constant Int :=
396 Int (Current_Line_Start) -
397 Wide_Char_Byte_Count;
401 Style.Check_Line_Terminator (Len);
404 -- Deal with checking maximum line length
406 if Style_Check and Style_Check_Max_Line_Length then
407 Style.Check_Line_Max_Length (Len);
409 -- If style checking is inactive, check maximum line length against
412 elsif Len > Max_Line_Length then
416 -- Now one more checking circuit. Normally we are only enforcing a
417 -- limit of physical characters, with tabs counting as one character.
418 -- But if after tab expansion we would have a total line length that
419 -- exceeded 32766, that would really cause trouble, because column
420 -- positions would exceed the maximum we allow for a column count.
421 -- Note: the limit is 32766 rather than 32767, since we use a value
422 -- of 32767 for special purposes (see Sinput). Now we really do not
423 -- want to go messing with tabs in the normal case, so what we do is
424 -- to check for a line that has more than 4096 physical characters.
425 -- Any shorter line could not be a problem, even if it was all tabs.
434 Ptr := Current_Line_Start;
436 exit when Ptr = Scan_Ptr;
438 if Source (Ptr) = ASCII.HT then
439 Col := (Col - 1 + 8) / 8 * 8 + 1;
446 ("this line is longer than 32766 characters",
448 raise Unrecoverable_Error;
456 -- Reset wide character byte count for next line
458 Wide_Char_Byte_Count := 0;
459 end Check_End_Of_Line;
461 -----------------------
462 -- Double_Char_Token --
463 -----------------------
465 function Double_Char_Token (C : Character) return Boolean is
467 if Source (Scan_Ptr + 1) = C then
468 Accumulate_Checksum (C);
469 Scan_Ptr := Scan_Ptr + 2;
472 elsif Source (Scan_Ptr + 1) = ' '
473 and then Source (Scan_Ptr + 2) = C
475 Scan_Ptr := Scan_Ptr + 1;
476 Error_Msg_S -- CODEFIX
477 ("no space allowed here");
478 Scan_Ptr := Scan_Ptr + 2;
484 end Double_Char_Token;
486 -----------------------------
487 -- Error_Illegal_Character --
488 -----------------------------
490 procedure Error_Illegal_Character is
492 Error_Msg_S ("illegal character");
493 Scan_Ptr := Scan_Ptr + 1;
494 end Error_Illegal_Character;
496 ----------------------------------
497 -- Error_Illegal_Wide_Character --
498 ----------------------------------
500 procedure Error_Illegal_Wide_Character is
502 Scan_Ptr := Scan_Ptr + 1;
503 Error_Msg ("illegal wide character", Wptr);
504 end Error_Illegal_Wide_Character;
506 ---------------------
507 -- Error_Long_Line --
508 ---------------------
510 procedure Error_Long_Line is
513 ("this line is too long",
514 Current_Line_Start + Source_Ptr (Max_Line_Length));
517 -------------------------------
518 -- Error_No_Double_Underline --
519 -------------------------------
521 procedure Error_No_Double_Underline is
523 Underline_Found := False;
525 -- There are four cases, and we special case the messages
527 if Source (Scan_Ptr) = '_' then
528 if Source (Scan_Ptr - 1) = '_' then
529 Error_Msg_S -- CODEFIX
530 ("two consecutive underlines not permitted");
532 Error_Msg_S ("underline cannot follow punctuation character");
536 if Source (Scan_Ptr - 1) = '_' then
537 Error_Msg_S ("punctuation character cannot follow underline");
540 ("two consecutive punctuation characters not permitted");
543 end Error_No_Double_Underline;
552 -- Current source program character
554 Base_Char : Character;
555 -- Either # or : (character at start of based number)
561 -- Value of base in Uint format
564 -- Value of integer scanned by Scan_Integer in Uint format
567 -- Value of integer in numeric value being scanned
570 -- Scale value for real literal
573 -- Scale in Uint format
575 Exponent_Is_Negative : Boolean;
576 -- Set true for negative exponent
578 Extended_Digit_Value : Int;
579 -- Extended digit value
581 Point_Scanned : Boolean;
582 -- Flag for decimal point scanned in numeric literal
584 -----------------------
585 -- Local Subprograms --
586 -----------------------
588 procedure Error_Digit_Expected;
589 -- Signal error of bad digit, Scan_Ptr points to the location at
590 -- which the digit was expected on input, and is unchanged on return.
592 procedure Scan_Integer;
593 -- Procedure to scan integer literal. On entry, Scan_Ptr points to a
594 -- digit, on exit Scan_Ptr points past the last character of the
597 -- For each digit encountered, UI_Int_Value is multiplied by 10, and
598 -- the value of the digit added to the result. In addition, the
599 -- value in Scale is decremented by one for each actual digit
602 --------------------------
603 -- Error_Digit_Expected --
604 --------------------------
606 procedure Error_Digit_Expected is
608 Error_Msg_S ("digit expected");
609 end Error_Digit_Expected;
615 procedure Scan_Integer is
617 -- Next character scanned
620 C := Source (Scan_Ptr);
622 -- Loop through digits (allowing underlines)
625 Accumulate_Checksum (C);
627 UI_Int_Value * 10 + (Character'Pos (C) - Character'Pos ('0'));
628 Scan_Ptr := Scan_Ptr + 1;
630 C := Source (Scan_Ptr);
632 -- Case of underline encountered
636 -- We do not accumulate the '_' in the checksum, so that
637 -- 1_234 is equivalent to 1234, and does not trigger
638 -- compilation for "minimal recompilation" (gnatmake -m).
641 Scan_Ptr := Scan_Ptr + 1;
642 C := Source (Scan_Ptr);
644 Error_No_Double_Underline;
647 if C not in '0' .. '9' then
648 Error_Digit_Expected;
653 exit when C not in '0' .. '9';
658 -- Start of Processing for Nlit
663 UI_Int_Value := Uint_0;
664 Based_Literal_Uses_Colon := False;
667 Point_Scanned := False;
668 UI_Num_Value := UI_Int_Value;
670 -- Various possibilities now for continuing the literal are period,
671 -- E/e (for exponent), or :/# (for based literal).
674 C := Source (Scan_Ptr);
678 -- Scan out point, but do not scan past .. which is a range
679 -- sequence, and must not be eaten up scanning a numeric literal.
681 while C = '.' and then Source (Scan_Ptr + 1) /= '.' loop
682 Accumulate_Checksum ('.');
684 if Point_Scanned then
685 Error_Msg_S ("duplicate point ignored");
688 Point_Scanned := True;
689 Scan_Ptr := Scan_Ptr + 1;
690 C := Source (Scan_Ptr);
692 if C not in '0' .. '9' then
694 ("real literal cannot end with point", Scan_Ptr - 1);
697 UI_Num_Value := UI_Int_Value;
701 -- Based literal case. The base is the value we already scanned.
702 -- In the case of colon, we insist that the following character
703 -- is indeed an extended digit or a period. This catches a number
704 -- of common errors, as well as catching the well known tricky
705 -- bug otherwise arising from "x : integer range 1 .. 10:= 6;"
708 or else (C = ':' and then
709 (Source (Scan_Ptr + 1) = '.'
711 Source (Scan_Ptr + 1) in '0' .. '9'
713 Source (Scan_Ptr + 1) in 'A' .. 'Z'
715 Source (Scan_Ptr + 1) in 'a' .. 'z'))
717 Accumulate_Checksum (C);
719 UI_Base := UI_Int_Value;
721 if Base_Char = ':' then
722 Based_Literal_Uses_Colon := True;
725 if UI_Base < 2 or else UI_Base > 16 then
726 Error_Msg_SC ("base not 2-16");
730 Base := UI_To_Int (UI_Base);
731 Scan_Ptr := Scan_Ptr + 1;
733 -- Scan out extended integer [. integer]
735 C := Source (Scan_Ptr);
736 UI_Int_Value := Uint_0;
740 if C in '0' .. '9' then
741 Accumulate_Checksum (C);
742 Extended_Digit_Value :=
743 Int'(Character'Pos (C)) - Int'(Character'Pos ('0'));
745 elsif C in 'A' .. 'F' then
746 Accumulate_Checksum (Character'Val (Character'Pos (C) + 32));
747 Extended_Digit_Value :=
748 Int'(Character'Pos (C)) - Int'(Character'Pos ('A')) + 10;
750 elsif C in 'a' .. 'f' then
751 Accumulate_Checksum (C);
752 Extended_Digit_Value :=
753 Int'(Character'Pos (C)) - Int'(Character'Pos ('a')) + 10;
756 Error_Msg_S ("extended digit expected");
760 if Extended_Digit_Value >= Base then
761 Error_Msg_S ("digit '>= base");
764 UI_Int_Value := UI_Int_Value * UI_Base + Extended_Digit_Value;
766 Scan_Ptr := Scan_Ptr + 1;
767 C := Source (Scan_Ptr);
771 Accumulate_Checksum ('_');
772 Scan_Ptr := Scan_Ptr + 1;
773 C := Source (Scan_Ptr);
775 Error_No_Double_Underline;
779 Accumulate_Checksum ('.');
781 if Point_Scanned then
782 Error_Msg_S ("duplicate point ignored");
785 Scan_Ptr := Scan_Ptr + 1;
786 C := Source (Scan_Ptr);
787 Point_Scanned := True;
790 elsif C = Base_Char then
791 Accumulate_Checksum (C);
792 Scan_Ptr := Scan_Ptr + 1;
795 elsif C = '#' or else C = ':' then
796 Error_Msg_S ("based number delimiters must match");
797 Scan_Ptr := Scan_Ptr + 1;
800 elsif not Identifier_Char (C) then
801 if Base_Char = '#' then
802 Error_Msg_S -- CODEFIX
805 Error_Msg_S -- CODEFIX
814 UI_Num_Value := UI_Int_Value;
819 if not Point_Scanned then
823 UI_Scale := UI_From_Int (Scale);
826 if Source (Scan_Ptr) = 'e' or else Source (Scan_Ptr) = 'E' then
827 Accumulate_Checksum ('e');
828 Scan_Ptr := Scan_Ptr + 1;
829 Exponent_Is_Negative := False;
831 if Source (Scan_Ptr) = '+' then
832 Accumulate_Checksum ('+');
833 Scan_Ptr := Scan_Ptr + 1;
835 elsif Source (Scan_Ptr) = '-' then
836 Accumulate_Checksum ('-');
838 if not Point_Scanned then
840 ("negative exponent not allowed for integer literal");
842 Exponent_Is_Negative := True;
845 Scan_Ptr := Scan_Ptr + 1;
848 UI_Int_Value := Uint_0;
850 if Source (Scan_Ptr) in '0' .. '9' then
853 Error_Digit_Expected;
856 if Exponent_Is_Negative then
857 UI_Scale := UI_Scale - UI_Int_Value;
859 UI_Scale := UI_Scale + UI_Int_Value;
863 -- Case of real literal to be returned
865 if Point_Scanned then
866 Token := Tok_Real_Literal;
867 Real_Literal_Value :=
873 -- Case of integer literal to be returned
876 Token := Tok_Integer_Literal;
879 Int_Literal_Value := UI_Num_Value;
881 -- Avoid doing possibly expensive calculations in cases like
882 -- parsing 163E800_000# when semantics will not be done anyway.
883 -- This is especially useful when parsing garbled input.
885 elsif Operating_Mode /= Check_Syntax
886 and then (Serious_Errors_Detected = 0 or else Try_Semantics)
888 Int_Literal_Value := UI_Num_Value * UI_Base ** UI_Scale;
891 Int_Literal_Value := No_Uint;
895 if Checksum_Accumulate_Token_Checksum then
896 Accumulate_Token_Checksum;
908 Delimiter : Character;
909 -- Delimiter (first character of string)
912 -- Current source program character
915 -- Current character code value
918 -- Error flag for Scan_Wide call
920 procedure Error_Bad_String_Char;
921 -- Signal bad character in string/character literal. On entry
922 -- Scan_Ptr points to the improper character encountered during the
923 -- scan. Scan_Ptr is not modified, so it still points to the bad
924 -- character on return.
926 procedure Error_Unterminated_String;
927 -- Procedure called if a line terminator character is encountered
928 -- during scanning a string, meaning that the string is not properly
931 procedure Set_String;
932 -- Procedure used to distinguish between string and operator symbol.
933 -- On entry the string has been scanned out, and its characters start
934 -- at Token_Ptr and end one character before Scan_Ptr. On exit Token
935 -- is set to Tok_String_Literal/Tok_Operator_Symbol as appropriate,
936 -- and Token_Node is appropriately initialized. In addition, in the
937 -- operator symbol case, Token_Name is appropriately set, and the
938 -- flags [Wide_]Wide_Character_Found are set appropriately.
940 ---------------------------
941 -- Error_Bad_String_Char --
942 ---------------------------
944 procedure Error_Bad_String_Char is
945 C : constant Character := Source (Scan_Ptr);
949 Error_Msg_S ("horizontal tab not allowed in string");
951 elsif C = VT or else C = FF then
952 Error_Msg_S ("format effector not allowed in string");
954 elsif C in Upper_Half_Character then
955 Error_Msg_S ("(Ada 83) upper half character not allowed");
958 Error_Msg_S ("control character not allowed in string");
960 end Error_Bad_String_Char;
962 -------------------------------
963 -- Error_Unterminated_String --
964 -------------------------------
966 procedure Error_Unterminated_String is
968 -- An interesting little refinement. Consider the following
971 -- A := "this is an unterminated string;
972 -- A := "this is an unterminated string &
973 -- P(A, "this is a parameter that didn't get terminated);
975 -- We fiddle a little to do slightly better placement in these
976 -- cases also if there is white space at the end of the line we
977 -- place the flag at the start of this white space, not at the
978 -- end. Note that we only have to test for blanks, since tabs
979 -- aren't allowed in strings in the first place and would have
980 -- caused an error message.
982 -- Two more cases that we treat specially are:
984 -- A := "this string uses the wrong terminator'
985 -- A := "this string uses the wrong terminator' &
987 -- In these cases we give a different error message as well
989 -- We actually reposition the scan pointer to the point where we
990 -- place the flag in these cases, since it seems a better bet on
991 -- the original intention.
993 while Source (Scan_Ptr - 1) = ' '
994 or else Source (Scan_Ptr - 1) = '&'
996 Scan_Ptr := Scan_Ptr - 1;
1000 -- Check for case of incorrect string terminator, but single quote
1001 -- is not considered incorrect if the opening terminator misused
1002 -- a single quote (error message already given).
1005 and then Source (Scan_Ptr - 1) = '''
1007 Unstore_String_Char;
1009 ("incorrect string terminator character", Scan_Ptr - 1);
1013 if Source (Scan_Ptr - 1) = ';' then
1014 Scan_Ptr := Scan_Ptr - 1;
1015 Unstore_String_Char;
1017 if Source (Scan_Ptr - 1) = ')' then
1018 Scan_Ptr := Scan_Ptr - 1;
1019 Unstore_String_Char;
1023 Error_Msg_S -- CODEFIX
1024 ("missing string quote");
1025 end Error_Unterminated_String;
1031 procedure Set_String is
1032 Slen : constant Int := Int (Scan_Ptr - Token_Ptr - 2);
1038 -- Token_Name is currently set to Error_Name. The following
1039 -- section of code resets Token_Name to the proper Name_Op_xx
1040 -- value if the string is a valid operator symbol, otherwise it is
1041 -- left set to Error_Name.
1044 C1 := Source (Token_Ptr + 1);
1048 Token_Name := Name_Op_Eq;
1051 Token_Name := Name_Op_Gt;
1054 Token_Name := Name_Op_Lt;
1057 Token_Name := Name_Op_Add;
1060 Token_Name := Name_Op_Subtract;
1063 Token_Name := Name_Op_Concat;
1066 Token_Name := Name_Op_Multiply;
1069 Token_Name := Name_Op_Divide;
1076 C1 := Source (Token_Ptr + 1);
1077 C2 := Source (Token_Ptr + 2);
1079 if C1 = '*' and then C2 = '*' then
1080 Token_Name := Name_Op_Expon;
1085 Token_Name := Name_Op_Ne;
1087 Token_Name := Name_Op_Le;
1089 Token_Name := Name_Op_Ge;
1092 elsif (C1 = 'O' or else C1 = 'o') and then -- OR
1093 (C2 = 'R' or else C2 = 'r')
1095 Token_Name := Name_Op_Or;
1099 C1 := Source (Token_Ptr + 1);
1100 C2 := Source (Token_Ptr + 2);
1101 C3 := Source (Token_Ptr + 3);
1103 if (C1 = 'A' or else C1 = 'a') and then -- AND
1104 (C2 = 'N' or else C2 = 'n') and then
1105 (C3 = 'D' or else C3 = 'd')
1107 Token_Name := Name_Op_And;
1109 elsif (C1 = 'A' or else C1 = 'a') and then -- ABS
1110 (C2 = 'B' or else C2 = 'b') and then
1111 (C3 = 'S' or else C3 = 's')
1113 Token_Name := Name_Op_Abs;
1115 elsif (C1 = 'M' or else C1 = 'm') and then -- MOD
1116 (C2 = 'O' or else C2 = 'o') and then
1117 (C3 = 'D' or else C3 = 'd')
1119 Token_Name := Name_Op_Mod;
1121 elsif (C1 = 'N' or else C1 = 'n') and then -- NOT
1122 (C2 = 'O' or else C2 = 'o') and then
1123 (C3 = 'T' or else C3 = 't')
1125 Token_Name := Name_Op_Not;
1127 elsif (C1 = 'R' or else C1 = 'r') and then -- REM
1128 (C2 = 'E' or else C2 = 'e') and then
1129 (C3 = 'M' or else C3 = 'm')
1131 Token_Name := Name_Op_Rem;
1133 elsif (C1 = 'X' or else C1 = 'x') and then -- XOR
1134 (C2 = 'O' or else C2 = 'o') and then
1135 (C3 = 'R' or else C3 = 'r')
1137 Token_Name := Name_Op_Xor;
1142 -- If it is an operator symbol, then Token_Name is set. If it is
1143 -- some other string value, then Token_Name still contains
1146 if Token_Name = Error_Name then
1147 Token := Tok_String_Literal;
1150 Token := Tok_Operator_Symbol;
1154 -- Start of processing for Slit
1157 -- On entry, Scan_Ptr points to the opening character of the string
1158 -- which is either a percent, double quote, or apostrophe (single
1159 -- quote). The latter case is an error detected by the character
1162 Delimiter := Source (Scan_Ptr);
1163 Accumulate_Checksum (Delimiter);
1166 Wide_Character_Found := False;
1167 Wide_Wide_Character_Found := False;
1168 Scan_Ptr := Scan_Ptr + 1;
1170 -- Loop to scan out characters of string literal
1173 C := Source (Scan_Ptr);
1175 if C = Delimiter then
1176 Accumulate_Checksum (C);
1177 Scan_Ptr := Scan_Ptr + 1;
1178 exit when Source (Scan_Ptr) /= Delimiter;
1179 Code := Get_Char_Code (C);
1180 Accumulate_Checksum (C);
1181 Scan_Ptr := Scan_Ptr + 1;
1184 if C = '"' and then Delimiter = '%' then
1186 ("quote not allowed in percent delimited string");
1187 Code := Get_Char_Code (C);
1188 Scan_Ptr := Scan_Ptr + 1;
1190 elsif Start_Of_Wide_Character then
1192 Scan_Wide (Source, Scan_Ptr, Code, Err);
1195 Error_Illegal_Wide_Character;
1196 Code := Get_Char_Code (' ');
1199 Accumulate_Checksum (Code);
1201 -- In Ada 95 mode we allow any wide characters in a string
1202 -- but in Ada 2005, the set of characters allowed has been
1203 -- restricted to graphic characters.
1205 if Ada_Version >= Ada_2005
1206 and then Is_UTF_32_Non_Graphic (UTF_32 (Code))
1209 ("(Ada 2005) non-graphic character not permitted " &
1210 "in string literal", Wptr);
1214 Accumulate_Checksum (C);
1216 if C not in Graphic_Character then
1217 if C in Line_Terminator then
1218 Error_Unterminated_String;
1221 elsif C in Upper_Half_Character then
1222 if Ada_Version = Ada_83 then
1223 Error_Bad_String_Char;
1227 Error_Bad_String_Char;
1231 Code := Get_Char_Code (C);
1232 Scan_Ptr := Scan_Ptr + 1;
1236 Store_String_Char (Code);
1238 if not In_Character_Range (Code) then
1239 if In_Wide_Character_Range (Code) then
1240 Wide_Character_Found := True;
1242 Wide_Wide_Character_Found := True;
1247 String_Literal_Id := End_String;
1252 ----------------------------------
1253 -- Skip_Other_Format_Characters --
1254 ----------------------------------
1256 procedure Skip_Other_Format_Characters is
1262 while Start_Of_Wide_Character loop
1264 Scan_Wide (Source, Scan_Ptr, Code, Err);
1266 if not Is_UTF_32_Other (UTF_32 (Code)) then
1271 end Skip_Other_Format_Characters;
1273 -----------------------------
1274 -- Start_Of_Wide_Character --
1275 -----------------------------
1277 function Start_Of_Wide_Character return Boolean is
1278 C : constant Character := Source (Scan_Ptr);
1281 -- ESC encoding method with ESC present
1284 and then Wide_Character_Encoding_Method in WC_ESC_Encoding_Method
1288 -- Upper half character with upper half encoding
1290 elsif C in Upper_Half_Character and then Upper_Half_Encoding then
1293 -- Brackets encoding
1296 and then Source (Scan_Ptr + 1) = '"'
1297 and then Identifier_Char (Source (Scan_Ptr + 2))
1301 -- Not the start of a wide character
1306 end Start_Of_Wide_Character;
1308 -- Start of processing for Scan
1311 Prev_Token := Token;
1312 Prev_Token_Ptr := Token_Ptr;
1313 Token_Name := Error_Name;
1315 -- The following loop runs more than once only if a format effector
1316 -- (tab, vertical tab, form feed, line feed, carriage return) is
1317 -- encountered and skipped, or some error situation, such as an
1318 -- illegal character, is encountered.
1320 <<Scan_Next_Character>>
1323 -- Skip past blanks, loop is opened up for speed
1325 while Source (Scan_Ptr) = ' ' loop
1326 if Source (Scan_Ptr + 1) /= ' ' then
1327 Scan_Ptr := Scan_Ptr + 1;
1331 if Source (Scan_Ptr + 2) /= ' ' then
1332 Scan_Ptr := Scan_Ptr + 2;
1336 if Source (Scan_Ptr + 3) /= ' ' then
1337 Scan_Ptr := Scan_Ptr + 3;
1341 if Source (Scan_Ptr + 4) /= ' ' then
1342 Scan_Ptr := Scan_Ptr + 4;
1346 if Source (Scan_Ptr + 5) /= ' ' then
1347 Scan_Ptr := Scan_Ptr + 5;
1351 if Source (Scan_Ptr + 6) /= ' ' then
1352 Scan_Ptr := Scan_Ptr + 6;
1356 if Source (Scan_Ptr + 7) /= ' ' then
1357 Scan_Ptr := Scan_Ptr + 7;
1361 Scan_Ptr := Scan_Ptr + 8;
1364 -- We are now at a non-blank character, which is the first character
1365 -- of the token we will scan, and hence the value of Token_Ptr.
1367 Token_Ptr := Scan_Ptr;
1369 -- Here begins the main case statement which transfers control on the
1370 -- basis of the non-blank character we have encountered.
1372 case Source (Scan_Ptr) is
1374 -- Line terminator characters
1376 when CR | LF | FF | VT =>
1377 goto Scan_Line_Terminator;
1379 -- Horizontal tab, just skip past it
1386 Scan_Ptr := Scan_Ptr + 1;
1388 -- End of file character, treated as an end of file only if it is
1389 -- the last character in the buffer, otherwise it is ignored.
1392 if Scan_Ptr = Source_Last (Current_Source_File) then
1402 Scan_Ptr := Scan_Ptr + 1;
1408 Accumulate_Checksum ('&');
1410 if Source (Scan_Ptr + 1) = '&' then
1411 Error_Msg_S -- CODEFIX
1412 ("'&'& should be `AND THEN`");
1413 Scan_Ptr := Scan_Ptr + 2;
1418 Scan_Ptr := Scan_Ptr + 1;
1419 Token := Tok_Ampersand;
1423 -- Asterisk (can be multiplication operator or double asterisk which
1424 -- is the exponentiation compound delimiter).
1427 Accumulate_Checksum ('*');
1429 if Source (Scan_Ptr + 1) = '*' then
1430 Accumulate_Checksum ('*');
1431 Scan_Ptr := Scan_Ptr + 2;
1432 Token := Tok_Double_Asterisk;
1436 Scan_Ptr := Scan_Ptr + 1;
1437 Token := Tok_Asterisk;
1441 -- Colon, which can either be an isolated colon, or part of an
1442 -- assignment compound delimiter.
1445 Accumulate_Checksum (':');
1447 if Double_Char_Token ('=') then
1448 Token := Tok_Colon_Equal;
1451 Style.Check_Colon_Equal;
1456 elsif Source (Scan_Ptr + 1) = '-'
1457 and then Source (Scan_Ptr + 2) /= '-'
1459 Token := Tok_Colon_Equal;
1460 Error_Msg -- CODEFIX
1461 (":- should be :=", Scan_Ptr);
1462 Scan_Ptr := Scan_Ptr + 2;
1466 Scan_Ptr := Scan_Ptr + 1;
1479 Accumulate_Checksum ('(');
1480 Scan_Ptr := Scan_Ptr + 1;
1481 Token := Tok_Left_Paren;
1484 Style.Check_Left_Paren;
1492 if Source (Scan_Ptr + 1) = '"' then
1493 goto Scan_Wide_Character;
1496 Error_Msg_S ("illegal character, replaced by ""(""");
1497 Scan_Ptr := Scan_Ptr + 1;
1498 Token := Tok_Left_Paren;
1505 Error_Msg_S ("illegal character, replaced by ""(""");
1506 Scan_Ptr := Scan_Ptr + 1;
1507 Token := Tok_Left_Paren;
1513 Accumulate_Checksum (',');
1514 Scan_Ptr := Scan_Ptr + 1;
1523 -- Dot, which is either an isolated period, or part of a double dot
1524 -- compound delimiter sequence. We also check for the case of a
1525 -- digit following the period, to give a better error message.
1528 Accumulate_Checksum ('.');
1530 if Double_Char_Token ('.') then
1531 Token := Tok_Dot_Dot;
1534 Style.Check_Dot_Dot;
1539 elsif Source (Scan_Ptr + 1) in '0' .. '9' then
1540 Error_Msg_S ("numeric literal cannot start with point");
1541 Scan_Ptr := Scan_Ptr + 1;
1544 Scan_Ptr := Scan_Ptr + 1;
1549 -- Equal, which can either be an equality operator, or part of the
1550 -- arrow (=>) compound delimiter.
1553 Accumulate_Checksum ('=');
1555 if Double_Char_Token ('>') then
1564 elsif Source (Scan_Ptr + 1) = '=' then
1565 Error_Msg_S -- CODEFIX
1567 Scan_Ptr := Scan_Ptr + 1;
1570 Scan_Ptr := Scan_Ptr + 1;
1574 -- Greater than, which can be a greater than operator, greater than
1575 -- or equal operator, or first character of a right label bracket.
1578 Accumulate_Checksum ('>');
1580 if Double_Char_Token ('=') then
1581 Token := Tok_Greater_Equal;
1584 elsif Double_Char_Token ('>') then
1585 Token := Tok_Greater_Greater;
1589 Scan_Ptr := Scan_Ptr + 1;
1590 Token := Tok_Greater;
1594 -- Less than, which can be a less than operator, less than or equal
1595 -- operator, or the first character of a left label bracket, or the
1596 -- first character of a box (<>) compound delimiter.
1599 Accumulate_Checksum ('<');
1601 if Double_Char_Token ('=') then
1602 Token := Tok_Less_Equal;
1605 elsif Double_Char_Token ('>') then
1614 elsif Double_Char_Token ('<') then
1615 Token := Tok_Less_Less;
1619 Scan_Ptr := Scan_Ptr + 1;
1624 -- Minus, which is either a subtraction operator, or the first
1625 -- character of double minus starting a comment
1627 when '-' => Minus_Case : begin
1628 if Source (Scan_Ptr + 1) = '>' then
1629 Error_Msg_S ("invalid token");
1630 Scan_Ptr := Scan_Ptr + 2;
1634 elsif Source (Scan_Ptr + 1) /= '-' then
1635 Accumulate_Checksum ('-');
1636 Scan_Ptr := Scan_Ptr + 1;
1642 else -- Source (Scan_Ptr + 1) = '-' then
1644 Style.Check_Comment;
1647 Scan_Ptr := Scan_Ptr + 2;
1649 -- If we are in preprocessor mode with Replace_In_Comments set,
1650 -- then we return the "--" as a token on its own.
1652 if Replace_In_Comments then
1653 Token := Tok_Comment;
1657 -- Otherwise scan out the comment
1659 Start_Of_Comment := Scan_Ptr;
1661 -- Loop to scan comment (this loop runs more than once only if
1662 -- a horizontal tab or other non-graphic character is scanned)
1665 -- Scan to non graphic character (opened up for speed)
1667 -- Note that we just eat left brackets, which means that
1668 -- bracket notation cannot be used for end of line
1669 -- characters in comments. This seems a reasonable choice,
1670 -- since no one would ever use brackets notation in a real
1671 -- program in this situation, and if we allow brackets
1672 -- notation, we forbid some valid comments which contain a
1673 -- brackets sequence that happens to match an end of line
1677 exit when Source (Scan_Ptr) not in Graphic_Character;
1678 Scan_Ptr := Scan_Ptr + 1;
1679 exit when Source (Scan_Ptr) not in Graphic_Character;
1680 Scan_Ptr := Scan_Ptr + 1;
1681 exit when Source (Scan_Ptr) not in Graphic_Character;
1682 Scan_Ptr := Scan_Ptr + 1;
1683 exit when Source (Scan_Ptr) not in Graphic_Character;
1684 Scan_Ptr := Scan_Ptr + 1;
1685 exit when Source (Scan_Ptr) not in Graphic_Character;
1686 Scan_Ptr := Scan_Ptr + 1;
1689 -- Keep going if horizontal tab
1691 if Source (Scan_Ptr) = HT then
1696 Scan_Ptr := Scan_Ptr + 1;
1698 -- Terminate scan of comment if line terminator
1700 elsif Source (Scan_Ptr) in Line_Terminator then
1703 -- Terminate scan of comment if end of file encountered
1704 -- (embedded EOF character or real last character in file)
1706 elsif Source (Scan_Ptr) = EOF then
1709 -- If we have a wide character, we have to scan it out,
1710 -- because it might be a legitimate line terminator
1712 elsif Start_Of_Wide_Character then
1714 Wptr : constant Source_Ptr := Scan_Ptr;
1719 Scan_Wide (Source, Scan_Ptr, Code, Err);
1721 -- If not well formed wide character, then just skip
1722 -- past it and ignore it.
1725 Scan_Ptr := Wptr + 1;
1727 -- If UTF_32 terminator, terminate comment scan
1729 elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then
1735 -- Keep going if character in 80-FF range, or is ESC. These
1736 -- characters are allowed in comments by RM-2.1(1), 2.7(2).
1737 -- They are allowed even in Ada 83 mode according to the
1738 -- approved AI. ESC was added to the AI in June 93.
1740 elsif Source (Scan_Ptr) in Upper_Half_Character
1741 or else Source (Scan_Ptr) = ESC
1743 Scan_Ptr := Scan_Ptr + 1;
1745 -- Otherwise we have an illegal comment character
1748 Error_Illegal_Character;
1752 -- Note that, except when comments are tokens, we do NOT
1753 -- execute a return here, instead we fall through to reexecute
1754 -- the scan loop to look for a token.
1756 if Comment_Is_Token then
1757 Name_Len := Integer (Scan_Ptr - Start_Of_Comment);
1758 Name_Buffer (1 .. Name_Len) :=
1759 String (Source (Start_Of_Comment .. Scan_Ptr - 1));
1760 Comment_Id := Name_Find;
1761 Token := Tok_Comment;
1765 if Source (Start_Of_Comment) = '#' then
1767 Scan_SPARK_Ptr : Source_Ptr;
1770 Scan_SPARK_Ptr := Start_Of_Comment + 1;
1774 while Source (Scan_SPARK_Ptr) = ' '
1775 or else Source (Scan_SPARK_Ptr) = HT
1777 Scan_SPARK_Ptr := Scan_SPARK_Ptr + 1;
1780 -- Recognize HIDE directive. SPARK input cannot be
1781 -- encoded as wide characters, so only deal with
1782 -- lower/upper case.
1784 if (Source (Scan_SPARK_Ptr) = 'h'
1785 or else Source (Scan_SPARK_Ptr) = 'H')
1786 and then (Source (Scan_SPARK_Ptr + 1) = 'i'
1787 or else Source (Scan_SPARK_Ptr + 1) = 'I')
1788 and then (Source (Scan_SPARK_Ptr + 2) = 'd'
1789 or else Source (Scan_SPARK_Ptr + 2) = 'D')
1790 and then (Source (Scan_SPARK_Ptr + 3) = 'e'
1791 or else Source (Scan_SPARK_Ptr + 3) = 'E')
1792 and then (Source (Scan_SPARK_Ptr + 4) = ' '
1793 or else Source (Scan_SPARK_Ptr + 4) = HT)
1795 Token := Tok_SPARK_Hide;
1803 -- Double quote or percent starting a string literal
1810 -- Apostrophe. This can either be the start of a character literal,
1811 -- or an isolated apostrophe used in a qualified expression or an
1812 -- attribute. We treat it as a character literal if it does not
1813 -- follow a right parenthesis, identifier, the keyword ALL or
1814 -- a literal. This means that we correctly treat constructs like:
1816 -- A := CHARACTER'('A');
1818 -- Note that RM-2.2(7) does not require a separator between
1819 -- "CHARACTER" and "'" in the above.
1821 when ''' => Char_Literal_Case : declare
1826 Accumulate_Checksum (''');
1827 Scan_Ptr := Scan_Ptr + 1;
1829 -- Here is where we make the test to distinguish the cases. Treat
1830 -- as apostrophe if previous token is an identifier, right paren
1831 -- or the reserved word "all" (latter case as in A.all'Address)
1832 -- (or the reserved word "project" in project files). Also treat
1833 -- it as apostrophe after a literal (this catches some legitimate
1834 -- cases, like A."abs"'Address, and also gives better error
1835 -- behavior for impossible cases like 123'xxx).
1837 if Prev_Token = Tok_Identifier
1838 or else Prev_Token = Tok_Right_Paren
1839 or else Prev_Token = Tok_All
1840 or else Prev_Token = Tok_Project
1841 or else Prev_Token in Token_Class_Literal
1843 Token := Tok_Apostrophe;
1846 Style.Check_Apostrophe;
1851 -- Otherwise the apostrophe starts a character literal
1854 -- Case of wide character literal
1856 if Start_Of_Wide_Character then
1858 Scan_Wide (Source, Scan_Ptr, Code, Err);
1859 Accumulate_Checksum (Code);
1862 Error_Illegal_Wide_Character;
1863 Code := Character'Pos (' ');
1865 -- In Ada 95 mode we allow any wide character in a character
1866 -- literal, but in Ada 2005, the set of characters allowed
1867 -- is restricted to graphic characters.
1869 elsif Ada_Version >= Ada_2005
1870 and then Is_UTF_32_Non_Graphic (UTF_32 (Code))
1872 Error_Msg -- CODEFIX????
1873 ("(Ada 2005) non-graphic character not permitted " &
1874 "in character literal", Wptr);
1877 if Source (Scan_Ptr) /= ''' then
1878 Error_Msg_S ("missing apostrophe");
1880 Scan_Ptr := Scan_Ptr + 1;
1883 -- If we do not find a closing quote in the expected place then
1884 -- assume that we have a misguided attempt at a string literal.
1886 -- However, if previous token is RANGE, then we return an
1887 -- apostrophe instead since this gives better error recovery
1889 elsif Source (Scan_Ptr + 1) /= ''' then
1890 if Prev_Token = Tok_Range then
1891 Token := Tok_Apostrophe;
1895 Scan_Ptr := Scan_Ptr - 1;
1897 ("strings are delimited by double quote character");
1903 -- Otherwise we have a (non-wide) character literal
1906 Accumulate_Checksum (Source (Scan_Ptr));
1908 if Source (Scan_Ptr) not in Graphic_Character then
1909 if Source (Scan_Ptr) in Upper_Half_Character then
1910 if Ada_Version = Ada_83 then
1911 Error_Illegal_Character;
1915 Error_Illegal_Character;
1919 Code := Get_Char_Code (Source (Scan_Ptr));
1920 Scan_Ptr := Scan_Ptr + 2;
1923 -- Fall through here with Scan_Ptr updated past the closing
1924 -- quote, and Code set to the Char_Code value for the literal
1926 Accumulate_Checksum (''');
1927 Token := Tok_Char_Literal;
1928 Set_Character_Literal_Name (Code);
1929 Token_Name := Name_Find;
1930 Character_Code := Code;
1934 end Char_Literal_Case;
1936 -- Right parenthesis
1939 Accumulate_Checksum (')');
1940 Scan_Ptr := Scan_Ptr + 1;
1941 Token := Tok_Right_Paren;
1944 Style.Check_Right_Paren;
1949 -- Right bracket or right brace, treated as right paren
1952 Error_Msg_S ("illegal character, replaced by "")""");
1953 Scan_Ptr := Scan_Ptr + 1;
1954 Token := Tok_Right_Paren;
1957 -- Slash (can be division operator or first character of not equal)
1960 Accumulate_Checksum ('/');
1962 if Double_Char_Token ('=') then
1963 Token := Tok_Not_Equal;
1966 Scan_Ptr := Scan_Ptr + 1;
1974 Accumulate_Checksum (';');
1975 Scan_Ptr := Scan_Ptr + 1;
1976 Token := Tok_Semicolon;
1979 Style.Check_Semicolon;
1986 when '|' => Vertical_Bar_Case : begin
1987 Accumulate_Checksum ('|');
1989 -- Special check for || to give nice message
1991 if Source (Scan_Ptr + 1) = '|' then
1992 Error_Msg_S -- CODEFIX
1993 ("""'|'|"" should be `OR ELSE`");
1994 Scan_Ptr := Scan_Ptr + 2;
1999 Scan_Ptr := Scan_Ptr + 1;
2000 Token := Tok_Vertical_Bar;
2003 Style.Check_Vertical_Bar;
2009 end Vertical_Bar_Case;
2011 -- Exclamation, replacement character for vertical bar
2013 when '!' => Exclamation_Case : begin
2014 Accumulate_Checksum ('!');
2016 if Source (Scan_Ptr + 1) = '=' then
2017 Error_Msg_S -- CODEFIX
2018 ("'!= should be /=");
2019 Scan_Ptr := Scan_Ptr + 2;
2020 Token := Tok_Not_Equal;
2024 Scan_Ptr := Scan_Ptr + 1;
2025 Token := Tok_Vertical_Bar;
2029 end Exclamation_Case;
2033 when '+' => Plus_Case : begin
2034 Accumulate_Checksum ('+');
2035 Scan_Ptr := Scan_Ptr + 1;
2040 -- Digits starting a numeric literal
2044 -- First a bit of a scan ahead to see if we have a case of an
2045 -- identifier starting with a digit (remembering exponent case).
2048 C : constant Character := Source (Scan_Ptr + 1);
2051 -- OK literal if digit followed by digit or underscore
2053 if C in '0' .. '9' or else C = '_' then
2056 -- OK literal if digit not followed by identifier char
2058 elsif not Identifier_Char (C) then
2061 -- OK literal if digit followed by e/E followed by digit/sign.
2062 -- We also allow underscore after the E, which is an error, but
2063 -- better handled by Nlit than deciding this is an identifier.
2065 elsif (C = 'e' or else C = 'E')
2066 and then (Source (Scan_Ptr + 2) in '0' .. '9'
2067 or else Source (Scan_Ptr + 2) = '+'
2068 or else Source (Scan_Ptr + 2) = '-'
2069 or else Source (Scan_Ptr + 2) = '_')
2073 -- Here we have what really looks like an identifier that
2074 -- starts with a digit, so give error msg.
2077 Error_Msg_S ("identifier may not start with digit");
2079 Underline_Found := False;
2080 Name_Buffer (1) := Source (Scan_Ptr);
2081 Accumulate_Checksum (Name_Buffer (1));
2082 Scan_Ptr := Scan_Ptr + 1;
2083 goto Scan_Identifier;
2087 -- Here we have an OK integer literal
2091 -- Check for proper delimiter, ignoring other format characters
2093 Skip_Other_Format_Characters;
2095 if Identifier_Char (Source (Scan_Ptr)) then
2097 ("delimiter required between literal and identifier");
2103 -- Lower case letters
2107 Underline_Found := False;
2108 Name_Buffer (1) := Source (Scan_Ptr);
2109 Accumulate_Checksum (Name_Buffer (1));
2110 Scan_Ptr := Scan_Ptr + 1;
2111 goto Scan_Identifier;
2113 -- Upper case letters
2117 Underline_Found := False;
2119 Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
2120 Accumulate_Checksum (Name_Buffer (1));
2121 Scan_Ptr := Scan_Ptr + 1;
2122 goto Scan_Identifier;
2124 -- Underline character
2127 if Special_Characters ('_') then
2128 Token_Ptr := Scan_Ptr;
2129 Scan_Ptr := Scan_Ptr + 1;
2130 Token := Tok_Special;
2131 Special_Character := '_';
2135 Error_Msg_S ("identifier cannot start with underline");
2137 Name_Buffer (1) := '_';
2138 Scan_Ptr := Scan_Ptr + 1;
2139 Underline_Found := False;
2140 goto Scan_Identifier;
2142 -- Space (not possible, because we scanned past blanks)
2145 raise Program_Error;
2147 -- Characters in top half of ASCII 8-bit chart
2149 when Upper_Half_Character =>
2151 -- Wide character case
2153 if Upper_Half_Encoding then
2154 goto Scan_Wide_Character;
2156 -- Otherwise we have OK Latin-1 character
2159 -- Upper half characters may possibly be identifier letters
2160 -- but can never be digits, so Identifier_Char can be used to
2161 -- test for a valid start of identifier character.
2163 if Identifier_Char (Source (Scan_Ptr)) then
2165 Underline_Found := False;
2166 goto Scan_Identifier;
2168 Error_Illegal_Character;
2174 -- ESC character, possible start of identifier if wide characters
2175 -- using ESC encoding are allowed in identifiers, which we can
2176 -- tell by looking at the Identifier_Char flag for ESC, which is
2177 -- only true if these conditions are met. In Ada 2005 mode, may
2178 -- also be valid UTF_32 space or line terminator character.
2180 if Identifier_Char (ESC) then
2182 goto Scan_Wide_Character;
2184 Error_Illegal_Character;
2187 -- Invalid control characters
2189 when NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | ASCII.SO |
2190 SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN |
2191 EM | FS | GS | RS | US | DEL
2193 Error_Illegal_Character;
2195 -- Invalid graphic characters
2197 when '#' | '$' | '?' | '@' | '`' | '\' | '^' | '~' =>
2199 -- If Set_Special_Character has been called for this character,
2200 -- set Scans.Special_Character and return a Special token.
2202 if Special_Characters (Source (Scan_Ptr)) then
2203 Token_Ptr := Scan_Ptr;
2204 Token := Tok_Special;
2205 Special_Character := Source (Scan_Ptr);
2206 Scan_Ptr := Scan_Ptr + 1;
2209 -- Otherwise, this is an illegal character
2212 Error_Illegal_Character;
2215 -- End switch on non-blank character
2219 -- End loop past format effectors. The exit from this loop is by
2220 -- executing a return statement following completion of token scan
2221 -- (control never falls out of this loop to the code which follows)
2225 -- Wide_Character scanning routine. On entry we have encountered the
2226 -- initial character of a wide character sequence.
2228 <<Scan_Wide_Character>>
2237 Scan_Wide (Source, Scan_Ptr, Code, Err);
2239 -- If bad wide character, signal error and continue scan
2242 Error_Illegal_Wide_Character;
2243 goto Scan_Next_Character;
2246 Cat := Get_Category (UTF_32 (Code));
2248 -- If OK letter, reset scan ptr and go scan identifier
2250 if Is_UTF_32_Letter (Cat) then
2253 Underline_Found := False;
2254 goto Scan_Identifier;
2256 -- If OK wide space, ignore and keep scanning (we do not include
2257 -- any ignored spaces in checksum)
2259 elsif Is_UTF_32_Space (Cat) then
2260 goto Scan_Next_Character;
2262 -- If other format character, ignore and keep scanning (again we
2263 -- do not include in the checksum) (this is for AI-0079).
2265 elsif Is_UTF_32_Other (Cat) then
2266 goto Scan_Next_Character;
2268 -- If OK wide line terminator, terminate current line
2270 elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then
2272 goto Scan_Line_Terminator;
2274 -- Punctuation is an error (at start of identifier)
2276 elsif Is_UTF_32_Punctuation (Cat) then
2277 Error_Msg ("identifier cannot start with punctuation", Wptr);
2280 Underline_Found := False;
2281 goto Scan_Identifier;
2283 -- Mark character is an error (at start of identifier)
2285 elsif Is_UTF_32_Mark (Cat) then
2286 Error_Msg ("identifier cannot start with mark character", Wptr);
2289 Underline_Found := False;
2290 goto Scan_Identifier;
2292 -- Extended digit character is an error. Could be bad start of
2293 -- identifier or bad literal. Not worth doing too much to try to
2294 -- distinguish these cases, but we will do a little bit.
2296 elsif Is_UTF_32_Digit (Cat) then
2298 ("identifier cannot start with digit character", Wptr);
2301 Underline_Found := False;
2302 goto Scan_Identifier;
2304 -- All other wide characters are illegal here
2307 Error_Illegal_Wide_Character;
2308 goto Scan_Next_Character;
2312 -- Routine to scan line terminator. On entry Scan_Ptr points to a
2313 -- character which is one of FF,LR,CR,VT, or one of the wide characters
2314 -- that is treated as a line terminator.
2316 <<Scan_Line_Terminator>>
2318 -- Check line too long
2322 -- Set Token_Ptr, if End_Of_Line is a token, for the case when it is
2325 if End_Of_Line_Is_Token then
2326 Token_Ptr := Scan_Ptr;
2333 Skip_Line_Terminators (Scan_Ptr, Physical);
2335 -- If we are at start of physical line, update scan pointers to
2336 -- reflect the start of the new line.
2339 Current_Line_Start := Scan_Ptr;
2340 Start_Column := Set_Start_Column;
2341 First_Non_Blank_Location := Scan_Ptr;
2343 -- If End_Of_Line is a token, we return it as it is a
2346 if End_Of_Line_Is_Token then
2347 Token := Tok_End_Of_Line;
2353 goto Scan_Next_Character;
2355 -- Identifier scanning routine. On entry, some initial characters of
2356 -- the identifier may have already been stored in Name_Buffer. If so,
2357 -- Name_Len has the number of characters stored, otherwise Name_Len is
2358 -- set to zero on entry. Underline_Found is also set False on entry.
2362 -- This loop scans as fast as possible past lower half letters and
2363 -- digits, which we expect to be the most common characters.
2366 if Source (Scan_Ptr) in 'a' .. 'z'
2367 or else Source (Scan_Ptr) in '0' .. '9'
2369 Name_Buffer (Name_Len + 1) := Source (Scan_Ptr);
2370 Accumulate_Checksum (Source (Scan_Ptr));
2372 elsif Source (Scan_Ptr) in 'A' .. 'Z' then
2373 Name_Buffer (Name_Len + 1) :=
2374 Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
2375 Accumulate_Checksum (Name_Buffer (Name_Len + 1));
2381 Underline_Found := False;
2382 Scan_Ptr := Scan_Ptr + 1;
2383 Name_Len := Name_Len + 1;
2386 -- If we fall through, then we have encountered either an underline
2387 -- character, or an extended identifier character (i.e. one from the
2388 -- upper half), or a wide character, or an identifier terminator. The
2389 -- initial test speeds us up in the most common case where we have
2390 -- an identifier terminator. Note that ESC is an identifier character
2391 -- only if a wide character encoding method that uses ESC encoding
2392 -- is active, so if we find an ESC character we know that we have a
2395 if Identifier_Char (Source (Scan_Ptr))
2396 or else (Source (Scan_Ptr) in Upper_Half_Character
2397 and then Upper_Half_Encoding)
2399 -- Case of underline
2401 if Source (Scan_Ptr) = '_' then
2402 Accumulate_Checksum ('_');
2404 if Underline_Found then
2405 Error_No_Double_Underline;
2407 Underline_Found := True;
2408 Name_Len := Name_Len + 1;
2409 Name_Buffer (Name_Len) := '_';
2412 Scan_Ptr := Scan_Ptr + 1;
2413 goto Scan_Identifier;
2415 -- Upper half character
2417 elsif Source (Scan_Ptr) in Upper_Half_Character
2418 and then not Upper_Half_Encoding
2420 Accumulate_Checksum (Source (Scan_Ptr));
2421 Store_Encoded_Character
2422 (Get_Char_Code (Fold_Lower (Source (Scan_Ptr))));
2423 Scan_Ptr := Scan_Ptr + 1;
2424 Underline_Found := False;
2425 goto Scan_Identifier;
2427 -- Left bracket not followed by a quote terminates an identifier.
2428 -- This is an error, but we don't want to give a junk error msg
2429 -- about wide characters in this case!
2431 elsif Source (Scan_Ptr) = '['
2432 and then Source (Scan_Ptr + 1) /= '"'
2436 -- We know we have a wide character encoding here (the current
2437 -- character is either ESC, left bracket, or an upper half
2438 -- character depending on the encoding method).
2441 -- Scan out the wide character and insert the appropriate
2442 -- encoding into the name table entry for the identifier.
2452 Scan_Wide (Source, Scan_Ptr, Code, Err);
2454 -- If error, signal error
2457 Error_Illegal_Wide_Character;
2459 -- If the character scanned is a normal identifier
2460 -- character, then we treat it that way.
2462 elsif In_Character_Range (Code)
2463 and then Identifier_Char (Get_Character (Code))
2465 Chr := Get_Character (Code);
2466 Accumulate_Checksum (Chr);
2467 Store_Encoded_Character
2468 (Get_Char_Code (Fold_Lower (Chr)));
2469 Underline_Found := False;
2471 -- Here if not a normal identifier character
2474 Cat := Get_Category (UTF_32 (Code));
2476 -- Wide character in Unicode category "Other, Format"
2477 -- is not accepted in an identifier. This is because it
2478 -- it is considered a security risk (AI-0091).
2480 -- However, it is OK for such a character to appear at
2481 -- the end of an identifier.
2483 if Is_UTF_32_Other (Cat) then
2484 if not Identifier_Char (Source (Scan_Ptr)) then
2485 goto Scan_Identifier_Complete;
2488 ("identifier cannot contain other_format "
2489 & "character", Wptr);
2490 goto Scan_Identifier;
2493 -- Wide character in category Separator,Space terminates
2495 elsif Is_UTF_32_Space (Cat) then
2496 goto Scan_Identifier_Complete;
2499 -- Here if wide character is part of the identifier
2501 -- Make sure we are allowing wide characters in
2502 -- identifiers. Note that we allow wide character
2503 -- notation for an OK identifier character. This in
2504 -- particular allows bracket or other notation to be
2505 -- used for upper half letters.
2507 -- Wide characters are always allowed in Ada 2005
2509 if Identifier_Character_Set /= 'w'
2510 and then Ada_Version < Ada_2005
2513 ("wide character not allowed in identifier", Wptr);
2516 -- If OK letter, store it folding to upper case. Note
2517 -- that we include the folded letter in the checksum.
2519 if Is_UTF_32_Letter (Cat) then
2521 Char_Code (UTF_32_To_Upper_Case (UTF_32 (Code)));
2522 Accumulate_Checksum (Code);
2523 Store_Encoded_Character (Code);
2524 Underline_Found := False;
2526 -- If OK extended digit or mark, then store it
2528 elsif Is_UTF_32_Digit (Cat)
2529 or else Is_UTF_32_Mark (Cat)
2531 Accumulate_Checksum (Code);
2532 Store_Encoded_Character (Code);
2533 Underline_Found := False;
2535 -- Wide punctuation is also stored, but counts as an
2536 -- underline character for error checking purposes.
2538 elsif Is_UTF_32_Punctuation (Cat) then
2539 Accumulate_Checksum (Code);
2541 if Underline_Found then
2543 Cend : constant Source_Ptr := Scan_Ptr;
2546 Error_No_Double_Underline;
2551 Store_Encoded_Character (Code);
2552 Underline_Found := True;
2555 -- Any other wide character is not acceptable
2559 ("invalid wide character in identifier", Wptr);
2563 goto Scan_Identifier;
2568 -- Scan of identifier is complete. The identifier is stored in
2569 -- Name_Buffer, and Scan_Ptr points past the last character.
2571 <<Scan_Identifier_Complete>>
2572 Token_Name := Name_Find;
2574 -- Check for identifier ending with underline or punctuation char
2576 if Underline_Found then
2577 Underline_Found := False;
2579 if Source (Scan_Ptr - 1) = '_' then
2581 ("identifier cannot end with underline", Scan_Ptr - 1);
2584 ("identifier cannot end with punctuation character", Wptr);
2588 -- We will assume it is an identifier, not a keyword, so that the
2589 -- checksum is independent of the Ada version.
2591 Token := Tok_Identifier;
2593 -- Here is where we check if it was a keyword
2595 if Is_Keyword_Name (Token_Name) then
2596 if Opt.Checksum_GNAT_6_3 then
2597 Token := Token_Type'Val (Get_Name_Table_Byte (Token_Name));
2599 if Checksum_Accumulate_Token_Checksum then
2600 if Checksum_GNAT_5_03 then
2601 Accumulate_Token_Checksum_GNAT_5_03;
2603 Accumulate_Token_Checksum_GNAT_6_3;
2608 Accumulate_Token_Checksum;
2609 Token := Token_Type'Val (Get_Name_Table_Byte (Token_Name));
2612 -- Keyword style checks
2616 -- Deal with possible style check for non-lower case keyword,
2617 -- but we don't treat ACCESS, DELTA, DIGITS, RANGE as keywords
2618 -- for this purpose if they appear as attribute designators.
2619 -- Actually we only check the first character for speed.
2621 -- Ada 2005 (AI-284): Do not apply the style check in case of
2622 -- "pragma Interface"
2624 -- Ada 2005 (AI-340): Do not apply the style check in case of
2627 if Source (Token_Ptr) <= 'Z'
2628 and then (Prev_Token /= Tok_Apostrophe
2630 (Token /= Tok_Access and then
2631 Token /= Tok_Delta and then
2632 Token /= Tok_Digits and then
2633 Token /= Tok_Mod and then
2634 Token /= Tok_Range))
2635 and then (Token /= Tok_Interface
2637 (Token = Tok_Interface
2638 and then Prev_Token /= Tok_Pragma))
2640 Style.Non_Lower_Case_Keyword;
2643 -- Check THEN/ELSE style rules. These do not apply to AND THEN
2644 -- or OR ELSE, and do not apply in conditional expressions.
2646 if (Token = Tok_Then and then Prev_Token /= Tok_And)
2648 (Token = Tok_Else and then Prev_Token /= Tok_Or)
2650 if Inside_Conditional_Expression = 0 then
2651 Style.Check_Separate_Stmt_Lines;
2656 -- We must reset Token_Name since this is not an identifier and
2657 -- if we leave Token_Name set, the parser gets confused because
2658 -- it thinks it is dealing with an identifier instead of the
2659 -- corresponding keyword.
2661 Token_Name := No_Name;
2664 -- It is an identifier after all
2667 if Checksum_Accumulate_Token_Checksum then
2668 Accumulate_Token_Checksum;
2676 --------------------------
2677 -- Set_Comment_As_Token --
2678 --------------------------
2680 procedure Set_Comment_As_Token (Value : Boolean) is
2682 Comment_Is_Token := Value;
2683 end Set_Comment_As_Token;
2685 ------------------------------
2686 -- Set_End_Of_Line_As_Token --
2687 ------------------------------
2689 procedure Set_End_Of_Line_As_Token (Value : Boolean) is
2691 End_Of_Line_Is_Token := Value;
2692 end Set_End_Of_Line_As_Token;
2694 ---------------------------
2695 -- Set_Special_Character --
2696 ---------------------------
2698 procedure Set_Special_Character (C : Character) is
2701 when '#' | '$' | '_' | '?' | '@' | '`' | '\' | '^' | '~' =>
2702 Special_Characters (C) := True;
2707 end Set_Special_Character;
2709 ----------------------
2710 -- Set_Start_Column --
2711 ----------------------
2713 -- Note: it seems at first glance a little expensive to compute this value
2714 -- for every source line (since it is certainly not used for all source
2715 -- lines). On the other hand, it doesn't take much more work to skip past
2716 -- the initial white space on the line counting the columns than it would
2717 -- to scan past the white space using the standard scanning circuits.
2719 function Set_Start_Column return Column_Number is
2720 Start_Column : Column_Number := 0;
2723 -- Outer loop scans past horizontal tab characters
2727 -- Inner loop scans past blanks as fast as possible, bumping Scan_Ptr
2728 -- past the blanks and adjusting Start_Column to account for them.
2731 if Source (Scan_Ptr) = ' ' then
2732 if Source (Scan_Ptr + 1) = ' ' then
2733 if Source (Scan_Ptr + 2) = ' ' then
2734 if Source (Scan_Ptr + 3) = ' ' then
2735 if Source (Scan_Ptr + 4) = ' ' then
2736 if Source (Scan_Ptr + 5) = ' ' then
2737 if Source (Scan_Ptr + 6) = ' ' then
2738 Scan_Ptr := Scan_Ptr + 7;
2739 Start_Column := Start_Column + 7;
2741 Scan_Ptr := Scan_Ptr + 6;
2742 Start_Column := Start_Column + 6;
2746 Scan_Ptr := Scan_Ptr + 5;
2747 Start_Column := Start_Column + 5;
2751 Scan_Ptr := Scan_Ptr + 4;
2752 Start_Column := Start_Column + 4;
2756 Scan_Ptr := Scan_Ptr + 3;
2757 Start_Column := Start_Column + 3;
2761 Scan_Ptr := Scan_Ptr + 2;
2762 Start_Column := Start_Column + 2;
2766 Scan_Ptr := Scan_Ptr + 1;
2767 Start_Column := Start_Column + 1;
2773 end loop Blanks_Loop;
2775 -- Outer loop keeps going only if a horizontal tab follows
2777 if Source (Scan_Ptr) = HT then
2782 Scan_Ptr := Scan_Ptr + 1;
2783 Start_Column := (Start_Column / 8) * 8 + 8;
2789 return Start_Column;
2791 -- A constraint error can happen only if we have a compiler with checks on
2792 -- and a line with a ludicrous number of tabs or spaces at the start. In
2793 -- such a case, we really don't care if Start_Column is right or not.
2796 when Constraint_Error =>
2797 return Start_Column;
2798 end Set_Start_Column;