1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, 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 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Csets; use Csets;
28 with Err_Vars; use Err_Vars;
29 with Hostparm; use Hostparm;
30 with Namet; use Namet;
32 with Scans; use Scans;
33 with Sinput; use Sinput;
34 with Snames; use Snames;
35 with Stringt; use Stringt;
36 with Stylesw; use Stylesw;
37 with Uintp; use Uintp;
38 with Urealp; use Urealp;
39 with Widechar; use Widechar;
42 with System.UTF_32; use System.UTF_32;
43 with System.WCh_Con; use System.WCh_Con;
48 -- Make control characters visible
50 Special_Characters : array (Character) of Boolean := (others => False);
51 -- For characters that are Special token, the value is True
53 Comment_Is_Token : Boolean := False;
54 -- True if comments are tokens
56 End_Of_Line_Is_Token : Boolean := False;
57 -- True if End_Of_Line is a token
59 -----------------------
60 -- Local Subprograms --
61 -----------------------
63 procedure Accumulate_Token_Checksum;
64 pragma Inline (Accumulate_Token_Checksum);
66 procedure Accumulate_Checksum (C : Character);
67 pragma Inline (Accumulate_Checksum);
68 -- This routine accumulates the checksum given character C. During the
69 -- scanning of a source file, this routine is called with every character
70 -- in the source, excluding blanks, and all control characters (except
71 -- that ESC is included in the checksum). Upper case letters not in string
72 -- literals are folded by the caller. See Sinput spec for the documentation
73 -- of the checksum algorithm. Note: checksum values are only used if we
74 -- generate code, so it is not necessary to worry about making the right
75 -- sequence of calls in any error situation.
77 procedure Accumulate_Checksum (C : Char_Code);
78 pragma Inline (Accumulate_Checksum);
79 -- This version is identical, except that the argument, C, is a character
80 -- code value instead of a character. This is used when wide characters
81 -- are scanned. We use the character code rather than the ASCII characters
82 -- so that the checksum is independent of wide character encoding method.
84 procedure Initialize_Checksum;
85 pragma Inline (Initialize_Checksum);
86 -- Initialize checksum value
88 -------------------------
89 -- Accumulate_Checksum --
90 -------------------------
92 procedure Accumulate_Checksum (C : Character) is
94 System.CRC32.Update (System.CRC32.CRC32 (Checksum), C);
95 end Accumulate_Checksum;
97 procedure Accumulate_Checksum (C : Char_Code) is
100 Accumulate_Checksum (Character'Val (C / 2 ** 24));
101 Accumulate_Checksum (Character'Val ((C / 2 ** 16) mod 256));
102 Accumulate_Checksum (Character'Val ((C / 256) mod 256));
104 Accumulate_Checksum (Character'Val (C / 256));
107 Accumulate_Checksum (Character'Val (C mod 256));
108 end Accumulate_Checksum;
110 -------------------------------
111 -- Accumulate_Token_Checksum --
112 -------------------------------
114 procedure Accumulate_Token_Checksum is
117 (System.CRC32.CRC32 (Checksum),
118 Character'Val (Token_Type'Pos (Token)));
119 end Accumulate_Token_Checksum;
121 ----------------------------
122 -- Determine_Token_Casing --
123 ----------------------------
125 function Determine_Token_Casing return Casing_Type is
127 return Determine_Casing (Source (Token_Ptr .. Scan_Ptr - 1));
128 end Determine_Token_Casing;
130 -------------------------
131 -- Initialize_Checksum --
132 -------------------------
134 procedure Initialize_Checksum is
136 System.CRC32.Initialize (System.CRC32.CRC32 (Checksum));
137 end Initialize_Checksum;
139 ------------------------
140 -- Initialize_Scanner --
141 ------------------------
143 procedure Initialize_Scanner (Index : Source_File_Index) is
145 -- Establish reserved words
147 Scans.Initialize_Ada_Keywords;
149 -- Initialize scan control variables
151 Current_Source_File := Index;
152 Source := Source_Text (Current_Source_File);
153 Scan_Ptr := Source_First (Current_Source_File);
155 Token_Ptr := Scan_Ptr;
156 Current_Line_Start := Scan_Ptr;
158 Token_Name := No_Name;
159 Start_Column := Set_Start_Column;
160 First_Non_Blank_Location := Scan_Ptr;
163 Wide_Char_Byte_Count := 0;
165 -- Do not call Scan, otherwise the License stuff does not work in Scn
167 end Initialize_Scanner;
169 ------------------------------
170 -- Reset_Special_Characters --
171 ------------------------------
173 procedure Reset_Special_Characters is
175 Special_Characters := (others => False);
176 end Reset_Special_Characters;
184 Start_Of_Comment : Source_Ptr;
185 -- Record start of comment position
187 Underline_Found : Boolean;
188 -- During scanning of an identifier, set to True if last character
189 -- scanned was an underline or other punctuation character. This
190 -- is used to flag the error of two underlines/punctuations in a
191 -- row or ending an identifier with a underline/punctuation. Here
192 -- punctuation means any UTF_32 character in the Unicode category
193 -- Punctuation,Connector.
196 -- Used to remember start of last wide character scanned
198 procedure Check_End_Of_Line;
199 -- Called when end of line encountered. Checks that line is not too
200 -- long, and that other style checks for the end of line are met.
202 function Double_Char_Token (C : Character) return Boolean;
203 -- This function is used for double character tokens like := or <>. It
204 -- checks if the character following Source (Scan_Ptr) is C, and if so
205 -- bumps Scan_Ptr past the pair of characters and returns True. A space
206 -- between the two characters is also recognized with an appropriate
207 -- error message being issued. If C is not present, False is returned.
208 -- Note that Double_Char_Token can only be used for tokens defined in
209 -- the Ada syntax (it's use for error cases like && is not appropriate
210 -- since we do not want a junk message for a case like &-space-&).
212 procedure Error_Illegal_Character;
213 -- Give illegal character error, Scan_Ptr points to character. On
214 -- return, Scan_Ptr is bumped past the illegal character.
216 procedure Error_Illegal_Wide_Character;
217 -- Give illegal wide character message. On return, Scan_Ptr is bumped
218 -- past the illegal character, which may still leave us pointing to
219 -- junk, not much we can do if the escape sequence is messed up!
221 procedure Error_Long_Line;
222 -- Signal error of excessively long line
224 procedure Error_No_Double_Underline;
225 -- Signal error of two underline or punctuation characters in a row.
226 -- Called with Scan_Ptr pointing to second underline/punctuation char.
229 -- This is the procedure for scanning out numeric literals. On entry,
230 -- Scan_Ptr points to the digit that starts the numeric literal (the
231 -- checksum for this character has not been accumulated yet). On return
232 -- Scan_Ptr points past the last character of the numeric literal, Token
233 -- and Token_Node are set appropriately, and the checksum is updated.
236 -- This is the procedure for scanning out string literals. On entry,
237 -- Scan_Ptr points to the opening string quote (the checksum for this
238 -- character has not been accumulated yet). On return Scan_Ptr points
239 -- past the closing quote of the string literal, Token and Token_Node
240 -- are set appropriately, and the checksum is upated.
242 -----------------------
243 -- Check_End_Of_Line --
244 -----------------------
246 procedure Check_End_Of_Line is
247 Len : constant Int :=
249 Int (Current_Line_Start) -
250 Wide_Char_Byte_Count;
254 Style.Check_Line_Terminator (Len);
257 -- Deal with checking maximum line length
259 if Style_Check and Style_Check_Max_Line_Length then
260 Style.Check_Line_Max_Length (Len);
262 -- If style checking is inactive, check maximum line length against
265 elsif Len > Max_Line_Length then
269 -- Now one more checking circuit. Normally we are only enforcing a
270 -- limit of physical characters, with tabs counting as one character.
271 -- But if after tab expansion we would have a total line length that
272 -- exceeded 32766, that would really cause trouble, because column
273 -- positions would exceed the maximum we allow for a column count.
274 -- Note: the limit is 32766 rather than 32767, since we use a value
275 -- of 32767 for special purposes (see Sinput). Now we really do not
276 -- want to go messing with tabs in the normal case, so what we do is
277 -- to check for a line that has more than 4096 physical characters.
278 -- Any shorter line could not be a problem, even if it was all tabs.
287 Ptr := Current_Line_Start;
289 exit when Ptr = Scan_Ptr;
291 if Source (Ptr) = ASCII.HT then
292 Col := (Col - 1 + 8) / 8 * 8 + 1;
299 ("this line is longer than 32766 characters",
301 raise Unrecoverable_Error;
309 -- Reset wide character byte count for next line
311 Wide_Char_Byte_Count := 0;
312 end Check_End_Of_Line;
314 -----------------------
315 -- Double_Char_Token --
316 -----------------------
318 function Double_Char_Token (C : Character) return Boolean is
320 if Source (Scan_Ptr + 1) = C then
321 Accumulate_Checksum (C);
322 Scan_Ptr := Scan_Ptr + 2;
325 elsif Source (Scan_Ptr + 1) = ' '
326 and then Source (Scan_Ptr + 2) = C
328 Scan_Ptr := Scan_Ptr + 1;
329 Error_Msg_S ("no space allowed here");
330 Scan_Ptr := Scan_Ptr + 2;
336 end Double_Char_Token;
338 -----------------------------
339 -- Error_Illegal_Character --
340 -----------------------------
342 procedure Error_Illegal_Character is
344 Error_Msg_S ("illegal character");
345 Scan_Ptr := Scan_Ptr + 1;
346 end Error_Illegal_Character;
348 ----------------------------------
349 -- Error_Illegal_Wide_Character --
350 ----------------------------------
352 procedure Error_Illegal_Wide_Character is
354 Error_Msg ("illegal wide character", Wptr);
355 end Error_Illegal_Wide_Character;
357 ---------------------
358 -- Error_Long_Line --
359 ---------------------
361 procedure Error_Long_Line is
364 ("this line is too long",
365 Current_Line_Start + Source_Ptr (Max_Line_Length));
368 -------------------------------
369 -- Error_No_Double_Underline --
370 -------------------------------
372 procedure Error_No_Double_Underline is
374 Underline_Found := False;
376 -- There are four cases, and we special case the messages
378 if Source (Scan_Ptr) = '_' then
379 if Source (Scan_Ptr - 1) = '_' then
381 ("two consecutive underlines not permitted");
384 ("underline cannot follow punctuation character");
388 if Source (Scan_Ptr - 1) = '_' then
390 ("punctuation character cannot follow underline");
393 ("two consecutive punctuation characters not permitted");
396 end Error_No_Double_Underline;
405 -- Current source program character
407 Base_Char : Character;
408 -- Either # or : (character at start of based number)
414 -- Value of base in Uint format
417 -- Value of integer scanned by Scan_Integer in Uint format
420 -- Value of integer in numeric value being scanned
423 -- Scale value for real literal
426 -- Scale in Uint format
428 Exponent_Is_Negative : Boolean;
429 -- Set true for negative exponent
431 Extended_Digit_Value : Int;
432 -- Extended digit value
434 Point_Scanned : Boolean;
435 -- Flag for decimal point scanned in numeric literal
437 -----------------------
438 -- Local Subprograms --
439 -----------------------
441 procedure Error_Digit_Expected;
442 -- Signal error of bad digit, Scan_Ptr points to the location at
443 -- which the digit was expected on input, and is unchanged on return.
445 procedure Scan_Integer;
446 -- Procedure to scan integer literal. On entry, Scan_Ptr points to a
447 -- digit, on exit Scan_Ptr points past the last character of the
450 -- For each digit encountered, UI_Int_Value is multiplied by 10, and
451 -- the value of the digit added to the result. In addition, the
452 -- value in Scale is decremented by one for each actual digit
455 --------------------------
456 -- Error_Digit_Expected --
457 --------------------------
459 procedure Error_Digit_Expected is
461 Error_Msg_S ("digit expected");
462 end Error_Digit_Expected;
468 procedure Scan_Integer is
470 -- Next character scanned
473 C := Source (Scan_Ptr);
475 -- Loop through digits (allowing underlines)
478 Accumulate_Checksum (C);
480 UI_Int_Value * 10 + (Character'Pos (C) - Character'Pos ('0'));
481 Scan_Ptr := Scan_Ptr + 1;
483 C := Source (Scan_Ptr);
485 -- Case of underline encountered
489 -- We do not accumulate the '_' in the checksum, so that
490 -- 1_234 is equivalent to 1234, and does not trigger
491 -- compilation for "minimal recompilation" (gnatmake -m).
494 Scan_Ptr := Scan_Ptr + 1;
495 C := Source (Scan_Ptr);
497 Error_No_Double_Underline;
500 if C not in '0' .. '9' then
501 Error_Digit_Expected;
506 exit when C not in '0' .. '9';
511 -- Start of Processing for Nlit
516 UI_Int_Value := Uint_0;
519 Point_Scanned := False;
520 UI_Num_Value := UI_Int_Value;
522 -- Various possibilities now for continuing the literal are period,
523 -- E/e (for exponent), or :/# (for based literal).
526 C := Source (Scan_Ptr);
530 -- Scan out point, but do not scan past .. which is a range
531 -- sequence, and must not be eaten up scanning a numeric literal.
533 while C = '.' and then Source (Scan_Ptr + 1) /= '.' loop
534 Accumulate_Checksum ('.');
536 if Point_Scanned then
537 Error_Msg_S ("duplicate point ignored");
540 Point_Scanned := True;
541 Scan_Ptr := Scan_Ptr + 1;
542 C := Source (Scan_Ptr);
544 if C not in '0' .. '9' then
546 ("real literal cannot end with point", Scan_Ptr - 1);
549 UI_Num_Value := UI_Int_Value;
553 -- Based literal case. The base is the value we already scanned.
554 -- In the case of colon, we insist that the following character
555 -- is indeed an extended digit or a period. This catches a number
556 -- of common errors, as well as catching the well known tricky
557 -- bug otherwise arising from "x : integer range 1 .. 10:= 6;"
560 or else (C = ':' and then
561 (Source (Scan_Ptr + 1) = '.'
563 Source (Scan_Ptr + 1) in '0' .. '9'
565 Source (Scan_Ptr + 1) in 'A' .. 'Z'
567 Source (Scan_Ptr + 1) in 'a' .. 'z'))
570 Obsolescent_Check (Scan_Ptr);
572 if Warn_On_Obsolescent_Feature then
574 ("use of "":"" is an obsolescent feature ('R'M 'J.2(3))?");
576 ("\use ""'#"" instead?");
580 Accumulate_Checksum (C);
582 UI_Base := UI_Int_Value;
584 if UI_Base < 2 or else UI_Base > 16 then
585 Error_Msg_SC ("base not 2-16");
589 Base := UI_To_Int (UI_Base);
590 Scan_Ptr := Scan_Ptr + 1;
592 -- Scan out extended integer [. integer]
594 C := Source (Scan_Ptr);
595 UI_Int_Value := Uint_0;
599 if C in '0' .. '9' then
600 Accumulate_Checksum (C);
601 Extended_Digit_Value :=
602 Int'(Character'Pos (C)) - Int'(Character'Pos ('0'));
604 elsif C in 'A' .. 'F' then
605 Accumulate_Checksum (Character'Val (Character'Pos (C) + 32));
606 Extended_Digit_Value :=
607 Int'(Character'Pos (C)) - Int'(Character'Pos ('A')) + 10;
609 elsif C in 'a' .. 'f' then
610 Accumulate_Checksum (C);
611 Extended_Digit_Value :=
612 Int'(Character'Pos (C)) - Int'(Character'Pos ('a')) + 10;
615 Error_Msg_S ("extended digit expected");
619 if Extended_Digit_Value >= Base then
620 Error_Msg_S ("digit '>= base");
623 UI_Int_Value := UI_Int_Value * UI_Base + Extended_Digit_Value;
625 Scan_Ptr := Scan_Ptr + 1;
626 C := Source (Scan_Ptr);
630 Accumulate_Checksum ('_');
631 Scan_Ptr := Scan_Ptr + 1;
632 C := Source (Scan_Ptr);
634 Error_No_Double_Underline;
638 Accumulate_Checksum ('.');
640 if Point_Scanned then
641 Error_Msg_S ("duplicate point ignored");
644 Scan_Ptr := Scan_Ptr + 1;
645 C := Source (Scan_Ptr);
646 Point_Scanned := True;
649 elsif C = Base_Char then
650 Accumulate_Checksum (C);
651 Scan_Ptr := Scan_Ptr + 1;
654 elsif C = '#' or else C = ':' then
655 Error_Msg_S ("based number delimiters must match");
656 Scan_Ptr := Scan_Ptr + 1;
659 elsif not Identifier_Char (C) then
660 if Base_Char = '#' then
661 Error_Msg_S ("missing '#");
663 Error_Msg_S ("missing ':");
671 UI_Num_Value := UI_Int_Value;
676 if not Point_Scanned then
680 UI_Scale := UI_From_Int (Scale);
683 if Source (Scan_Ptr) = 'e' or else Source (Scan_Ptr) = 'E' then
684 Accumulate_Checksum ('e');
685 Scan_Ptr := Scan_Ptr + 1;
686 Exponent_Is_Negative := False;
688 if Source (Scan_Ptr) = '+' then
689 Accumulate_Checksum ('+');
690 Scan_Ptr := Scan_Ptr + 1;
692 elsif Source (Scan_Ptr) = '-' then
693 Accumulate_Checksum ('-');
695 if not Point_Scanned then
697 ("negative exponent not allowed for integer literal");
699 Exponent_Is_Negative := True;
702 Scan_Ptr := Scan_Ptr + 1;
705 UI_Int_Value := Uint_0;
707 if Source (Scan_Ptr) in '0' .. '9' then
710 Error_Digit_Expected;
713 if Exponent_Is_Negative then
714 UI_Scale := UI_Scale - UI_Int_Value;
716 UI_Scale := UI_Scale + UI_Int_Value;
720 -- Case of real literal to be returned
722 if Point_Scanned then
723 Token := Tok_Real_Literal;
724 Real_Literal_Value :=
730 -- Case of integer literal to be returned
733 Token := Tok_Integer_Literal;
736 Int_Literal_Value := UI_Num_Value;
738 -- Avoid doing possibly expensive calculations in cases like
739 -- parsing 163E800_000# when semantics will not be done anyway.
740 -- This is especially useful when parsing garbled input.
742 elsif Operating_Mode /= Check_Syntax
743 and then (Serious_Errors_Detected = 0 or else Try_Semantics)
745 Int_Literal_Value := UI_Num_Value * UI_Base ** UI_Scale;
748 Int_Literal_Value := No_Uint;
752 Accumulate_Token_Checksum;
763 Delimiter : Character;
764 -- Delimiter (first character of string)
767 -- Current source program character
770 -- Current character code value
773 -- Error flag for Scan_Wide call
775 procedure Error_Bad_String_Char;
776 -- Signal bad character in string/character literal. On entry
777 -- Scan_Ptr points to the improper character encountered during the
778 -- scan. Scan_Ptr is not modified, so it still points to the bad
779 -- character on return.
781 procedure Error_Unterminated_String;
782 -- Procedure called if a line terminator character is encountered
783 -- during scanning a string, meaning that the string is not properly
786 procedure Set_String;
787 -- Procedure used to distinguish between string and operator symbol.
788 -- On entry the string has been scanned out, and its characters
789 -- start at Token_Ptr and end one character before Scan_Ptr. On exit
790 -- Token is set to Tok_String_Literal or Tok_Operator_Symbol as
791 -- appropriate, and Token_Node is appropriately initialized. In
792 -- addition, in the operator symbol case, Token_Name is
793 -- appropriately set.
795 ---------------------------
796 -- Error_Bad_String_Char --
797 ---------------------------
799 procedure Error_Bad_String_Char is
800 C : constant Character := Source (Scan_Ptr);
804 Error_Msg_S ("horizontal tab not allowed in string");
806 elsif C = VT or else C = FF then
807 Error_Msg_S ("format effector not allowed in string");
809 elsif C in Upper_Half_Character then
810 Error_Msg_S ("(Ada 83) upper half character not allowed");
813 Error_Msg_S ("control character not allowed in string");
815 end Error_Bad_String_Char;
817 -------------------------------
818 -- Error_Unterminated_String --
819 -------------------------------
821 procedure Error_Unterminated_String is
823 -- An interesting little refinement. Consider the following
826 -- A := "this is an unterminated string;
827 -- A := "this is an unterminated string &
828 -- P(A, "this is a parameter that didn't get terminated);
830 -- We fiddle a little to do slightly better placement in these
831 -- cases also if there is white space at the end of the line we
832 -- place the flag at the start of this white space, not at the
833 -- end. Note that we only have to test for blanks, since tabs
834 -- aren't allowed in strings in the first place and would have
835 -- caused an error message.
837 -- Two more cases that we treat specially are:
839 -- A := "this string uses the wrong terminator'
840 -- A := "this string uses the wrong terminator' &
842 -- In these cases we give a different error message as well
844 -- We actually reposition the scan pointer to the point where we
845 -- place the flag in these cases, since it seems a better bet on
846 -- the original intention.
848 while Source (Scan_Ptr - 1) = ' '
849 or else Source (Scan_Ptr - 1) = '&'
851 Scan_Ptr := Scan_Ptr - 1;
855 -- Check for case of incorrect string terminator, but single quote
856 -- is not considered incorrect if the opening terminator misused
857 -- a single quote (error message already given).
860 and then Source (Scan_Ptr - 1) = '''
864 ("incorrect string terminator character", Scan_Ptr - 1);
868 if Source (Scan_Ptr - 1) = ';' then
869 Scan_Ptr := Scan_Ptr - 1;
872 if Source (Scan_Ptr - 1) = ')' then
873 Scan_Ptr := Scan_Ptr - 1;
878 Error_Msg_S ("missing string quote");
879 end Error_Unterminated_String;
885 procedure Set_String is
886 Slen : constant Int := Int (Scan_Ptr - Token_Ptr - 2);
892 -- Token_Name is currently set to Error_Name. The following
893 -- section of code resets Token_Name to the proper Name_Op_xx
894 -- value if the string is a valid operator symbol, otherwise it is
895 -- left set to Error_Name.
898 C1 := Source (Token_Ptr + 1);
902 Token_Name := Name_Op_Eq;
905 Token_Name := Name_Op_Gt;
908 Token_Name := Name_Op_Lt;
911 Token_Name := Name_Op_Add;
914 Token_Name := Name_Op_Subtract;
917 Token_Name := Name_Op_Concat;
920 Token_Name := Name_Op_Multiply;
923 Token_Name := Name_Op_Divide;
930 C1 := Source (Token_Ptr + 1);
931 C2 := Source (Token_Ptr + 2);
933 if C1 = '*' and then C2 = '*' then
934 Token_Name := Name_Op_Expon;
939 Token_Name := Name_Op_Ne;
941 Token_Name := Name_Op_Le;
943 Token_Name := Name_Op_Ge;
946 elsif (C1 = 'O' or else C1 = 'o') and then -- OR
947 (C2 = 'R' or else C2 = 'r')
949 Token_Name := Name_Op_Or;
953 C1 := Source (Token_Ptr + 1);
954 C2 := Source (Token_Ptr + 2);
955 C3 := Source (Token_Ptr + 3);
957 if (C1 = 'A' or else C1 = 'a') and then -- AND
958 (C2 = 'N' or else C2 = 'n') and then
959 (C3 = 'D' or else C3 = 'd')
961 Token_Name := Name_Op_And;
963 elsif (C1 = 'A' or else C1 = 'a') and then -- ABS
964 (C2 = 'B' or else C2 = 'b') and then
965 (C3 = 'S' or else C3 = 's')
967 Token_Name := Name_Op_Abs;
969 elsif (C1 = 'M' or else C1 = 'm') and then -- MOD
970 (C2 = 'O' or else C2 = 'o') and then
971 (C3 = 'D' or else C3 = 'd')
973 Token_Name := Name_Op_Mod;
975 elsif (C1 = 'N' or else C1 = 'n') and then -- NOT
976 (C2 = 'O' or else C2 = 'o') and then
977 (C3 = 'T' or else C3 = 't')
979 Token_Name := Name_Op_Not;
981 elsif (C1 = 'R' or else C1 = 'r') and then -- REM
982 (C2 = 'E' or else C2 = 'e') and then
983 (C3 = 'M' or else C3 = 'm')
985 Token_Name := Name_Op_Rem;
987 elsif (C1 = 'X' or else C1 = 'x') and then -- XOR
988 (C2 = 'O' or else C2 = 'o') and then
989 (C3 = 'R' or else C3 = 'r')
991 Token_Name := Name_Op_Xor;
996 -- If it is an operator symbol, then Token_Name is set. If it is
997 -- some other string value, then Token_Name still contains
1000 if Token_Name = Error_Name then
1001 Token := Tok_String_Literal;
1004 Token := Tok_Operator_Symbol;
1008 -- Start of processing for Slit
1011 -- On entry, Scan_Ptr points to the opening character of the string
1012 -- which is either a percent, double quote, or apostrophe (single
1013 -- quote). The latter case is an error detected by the character
1016 Delimiter := Source (Scan_Ptr);
1017 Accumulate_Checksum (Delimiter);
1019 Scan_Ptr := Scan_Ptr + 1;
1021 -- Loop to scan out characters of string literal
1024 C := Source (Scan_Ptr);
1026 if C = Delimiter then
1027 Accumulate_Checksum (C);
1028 Scan_Ptr := Scan_Ptr + 1;
1029 exit when Source (Scan_Ptr) /= Delimiter;
1030 Code := Get_Char_Code (C);
1031 Accumulate_Checksum (C);
1032 Scan_Ptr := Scan_Ptr + 1;
1035 if C = '"' and then Delimiter = '%' then
1037 ("quote not allowed in percent delimited string");
1038 Code := Get_Char_Code (C);
1039 Scan_Ptr := Scan_Ptr + 1;
1042 and then Wide_Character_Encoding_Method
1043 in WC_ESC_Encoding_Method)
1044 or else (C in Upper_Half_Character
1045 and then Upper_Half_Encoding)
1047 and then Source (Scan_Ptr + 1) = '"'
1048 and then Identifier_Char (Source (Scan_Ptr + 2)))
1051 Scan_Wide (Source, Scan_Ptr, Code, Err);
1054 Error_Illegal_Wide_Character;
1055 Code := Get_Char_Code (' ');
1058 Accumulate_Checksum (Code);
1060 -- In Ada 95 mode we allow any wide characters in a string
1061 -- but in Ada 2005, the set of characters allowed has been
1062 -- restricted to graphic characters.
1064 if Ada_Version >= Ada_05
1065 and then Is_UTF_32_Non_Graphic (UTF_32 (Code))
1068 ("(Ada 2005) non-graphic character not permitted " &
1069 "in string literal", Wptr);
1073 Accumulate_Checksum (C);
1075 if C not in Graphic_Character then
1076 if C in Line_Terminator then
1077 Error_Unterminated_String;
1080 elsif C in Upper_Half_Character then
1081 if Ada_Version = Ada_83 then
1082 Error_Bad_String_Char;
1086 Error_Bad_String_Char;
1090 Code := Get_Char_Code (C);
1091 Scan_Ptr := Scan_Ptr + 1;
1095 Store_String_Char (Code);
1097 if not In_Character_Range (Code) then
1098 Wide_Character_Found := True;
1102 String_Literal_Id := End_String;
1107 -- Start of processing for Scan
1110 Prev_Token := Token;
1111 Prev_Token_Ptr := Token_Ptr;
1112 Token_Name := Error_Name;
1114 -- The following loop runs more than once only if a format effector
1115 -- (tab, vertical tab, form feed, line feed, carriage return) is
1116 -- encountered and skipped, or some error situation, such as an
1117 -- illegal character, is encountered.
1119 <<Scan_Next_Character>>
1122 -- Skip past blanks, loop is opened up for speed
1124 while Source (Scan_Ptr) = ' ' loop
1125 if Source (Scan_Ptr + 1) /= ' ' then
1126 Scan_Ptr := Scan_Ptr + 1;
1130 if Source (Scan_Ptr + 2) /= ' ' then
1131 Scan_Ptr := Scan_Ptr + 2;
1135 if Source (Scan_Ptr + 3) /= ' ' then
1136 Scan_Ptr := Scan_Ptr + 3;
1140 if Source (Scan_Ptr + 4) /= ' ' then
1141 Scan_Ptr := Scan_Ptr + 4;
1145 if Source (Scan_Ptr + 5) /= ' ' then
1146 Scan_Ptr := Scan_Ptr + 5;
1150 if Source (Scan_Ptr + 6) /= ' ' then
1151 Scan_Ptr := Scan_Ptr + 6;
1155 if Source (Scan_Ptr + 7) /= ' ' then
1156 Scan_Ptr := Scan_Ptr + 7;
1160 Scan_Ptr := Scan_Ptr + 8;
1163 -- We are now at a non-blank character, which is the first character
1164 -- of the token we will scan, and hence the value of Token_Ptr.
1166 Token_Ptr := Scan_Ptr;
1168 -- Here begins the main case statement which transfers control on the
1169 -- basis of the non-blank character we have encountered.
1171 case Source (Scan_Ptr) is
1173 -- Line terminator characters
1175 when CR | LF | FF | VT =>
1176 goto Scan_Line_Terminator;
1178 -- Horizontal tab, just skip past it
1181 if Style_Check then Style.Check_HT; end if;
1182 Scan_Ptr := Scan_Ptr + 1;
1184 -- End of file character, treated as an end of file only if it is
1185 -- the last character in the buffer, otherwise it is ignored.
1188 if Scan_Ptr = Source_Last (Current_Source_File) then
1190 if Style_Check then Style.Check_EOF; end if;
1194 Scan_Ptr := Scan_Ptr + 1;
1200 Accumulate_Checksum ('&');
1202 if Source (Scan_Ptr + 1) = '&' then
1203 Error_Msg_S ("'&'& should be `AND THEN`");
1204 Scan_Ptr := Scan_Ptr + 2;
1209 Scan_Ptr := Scan_Ptr + 1;
1210 Token := Tok_Ampersand;
1214 -- Asterisk (can be multiplication operator or double asterisk which
1215 -- is the exponentiation compound delimiter).
1218 Accumulate_Checksum ('*');
1220 if Source (Scan_Ptr + 1) = '*' then
1221 Accumulate_Checksum ('*');
1222 Scan_Ptr := Scan_Ptr + 2;
1223 Token := Tok_Double_Asterisk;
1227 Scan_Ptr := Scan_Ptr + 1;
1228 Token := Tok_Asterisk;
1232 -- Colon, which can either be an isolated colon, or part of an
1233 -- assignment compound delimiter.
1236 Accumulate_Checksum (':');
1238 if Double_Char_Token ('=') then
1239 Token := Tok_Colon_Equal;
1240 if Style_Check then Style.Check_Colon_Equal; end if;
1243 elsif Source (Scan_Ptr + 1) = '-'
1244 and then Source (Scan_Ptr + 2) /= '-'
1246 Token := Tok_Colon_Equal;
1247 Error_Msg (":- should be :=", Scan_Ptr);
1248 Scan_Ptr := Scan_Ptr + 2;
1252 Scan_Ptr := Scan_Ptr + 1;
1254 if Style_Check then Style.Check_Colon; end if;
1261 Accumulate_Checksum ('(');
1262 Scan_Ptr := Scan_Ptr + 1;
1263 Token := Tok_Left_Paren;
1264 if Style_Check then Style.Check_Left_Paren; end if;
1270 if Source (Scan_Ptr + 1) = '"' then
1271 goto Scan_Wide_Character;
1274 Error_Msg_S ("illegal character, replaced by ""(""");
1275 Scan_Ptr := Scan_Ptr + 1;
1276 Token := Tok_Left_Paren;
1283 Error_Msg_S ("illegal character, replaced by ""(""");
1284 Scan_Ptr := Scan_Ptr + 1;
1285 Token := Tok_Left_Paren;
1291 Accumulate_Checksum (',');
1292 Scan_Ptr := Scan_Ptr + 1;
1294 if Style_Check then Style.Check_Comma; end if;
1297 -- Dot, which is either an isolated period, or part of a double dot
1298 -- compound delimiter sequence. We also check for the case of a
1299 -- digit following the period, to give a better error message.
1302 Accumulate_Checksum ('.');
1304 if Double_Char_Token ('.') then
1305 Token := Tok_Dot_Dot;
1306 if Style_Check then Style.Check_Dot_Dot; end if;
1309 elsif Source (Scan_Ptr + 1) in '0' .. '9' then
1310 Error_Msg_S ("numeric literal cannot start with point");
1311 Scan_Ptr := Scan_Ptr + 1;
1314 Scan_Ptr := Scan_Ptr + 1;
1319 -- Equal, which can either be an equality operator, or part of the
1320 -- arrow (=>) compound delimiter.
1323 Accumulate_Checksum ('=');
1325 if Double_Char_Token ('>') then
1327 if Style_Check then Style.Check_Arrow; end if;
1330 elsif Source (Scan_Ptr + 1) = '=' then
1331 Error_Msg_S ("== should be =");
1332 Scan_Ptr := Scan_Ptr + 1;
1335 Scan_Ptr := Scan_Ptr + 1;
1339 -- Greater than, which can be a greater than operator, greater than
1340 -- or equal operator, or first character of a right label bracket.
1343 Accumulate_Checksum ('>');
1345 if Double_Char_Token ('=') then
1346 Token := Tok_Greater_Equal;
1349 elsif Double_Char_Token ('>') then
1350 Token := Tok_Greater_Greater;
1354 Scan_Ptr := Scan_Ptr + 1;
1355 Token := Tok_Greater;
1359 -- Less than, which can be a less than operator, less than or equal
1360 -- operator, or the first character of a left label bracket, or the
1361 -- first character of a box (<>) compound delimiter.
1364 Accumulate_Checksum ('<');
1366 if Double_Char_Token ('=') then
1367 Token := Tok_Less_Equal;
1370 elsif Double_Char_Token ('>') then
1372 if Style_Check then Style.Check_Box; end if;
1375 elsif Double_Char_Token ('<') then
1376 Token := Tok_Less_Less;
1380 Scan_Ptr := Scan_Ptr + 1;
1385 -- Minus, which is either a subtraction operator, or the first
1386 -- character of double minus starting a comment
1388 when '-' => Minus_Case : begin
1389 if Source (Scan_Ptr + 1) = '>' then
1390 Error_Msg_S ("invalid token");
1391 Scan_Ptr := Scan_Ptr + 2;
1395 elsif Source (Scan_Ptr + 1) /= '-' then
1396 Accumulate_Checksum ('-');
1397 Scan_Ptr := Scan_Ptr + 1;
1403 else -- Source (Scan_Ptr + 1) = '-' then
1404 if Style_Check then Style.Check_Comment; end if;
1405 Scan_Ptr := Scan_Ptr + 2;
1407 -- If we are in preprocessor mode with Replace_In_Comments set,
1408 -- then we return the "--" as a token on its own.
1410 if Replace_In_Comments then
1411 Token := Tok_Comment;
1415 -- Otherwise scan out the comment
1417 Start_Of_Comment := Scan_Ptr;
1419 -- Loop to scan comment (this loop runs more than once only if
1420 -- a horizontal tab or other non-graphic character is scanned)
1423 -- Scan to non graphic character (opened up for speed)
1425 -- Note that we just eat left brackets, which means that
1426 -- bracket notation cannot be used for end of line
1427 -- characters in comments. This seems a reasonable choice,
1428 -- since no one would ever use brackets notation in a real
1429 -- program in this situation, and if we allow brackets
1430 -- notation, we forbid some valid comments which contain a
1431 -- brackets sequence that happens to match an end of line
1435 exit when Source (Scan_Ptr) not in Graphic_Character;
1436 Scan_Ptr := Scan_Ptr + 1;
1437 exit when Source (Scan_Ptr) not in Graphic_Character;
1438 Scan_Ptr := Scan_Ptr + 1;
1439 exit when Source (Scan_Ptr) not in Graphic_Character;
1440 Scan_Ptr := Scan_Ptr + 1;
1441 exit when Source (Scan_Ptr) not in Graphic_Character;
1442 Scan_Ptr := Scan_Ptr + 1;
1443 exit when Source (Scan_Ptr) not in Graphic_Character;
1444 Scan_Ptr := Scan_Ptr + 1;
1447 -- Keep going if horizontal tab
1449 if Source (Scan_Ptr) = HT then
1450 if Style_Check then Style.Check_HT; end if;
1451 Scan_Ptr := Scan_Ptr + 1;
1453 -- Terminate scan of comment if line terminator
1455 elsif Source (Scan_Ptr) in Line_Terminator then
1458 -- Terminate scan of comment if end of file encountered
1459 -- (embedded EOF character or real last character in file)
1461 elsif Source (Scan_Ptr) = EOF then
1464 -- If we have a wide character, we have to scan it out,
1465 -- because it might be a legitimate line terminator
1467 elsif (Source (Scan_Ptr) = ESC
1468 and then Identifier_Char (ESC))
1470 (Source (Scan_Ptr) in Upper_Half_Character
1471 and then Upper_Half_Encoding)
1474 Wptr : constant Source_Ptr := Scan_Ptr;
1479 Scan_Wide (Source, Scan_Ptr, Code, Err);
1481 -- If not well formed wide character, then just skip
1482 -- past it and ignore it.
1485 Scan_Ptr := Wptr + 1;
1487 -- If UTF_32 terminator, terminate comment scan
1489 elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then
1495 -- Keep going if character in 80-FF range, or is ESC. These
1496 -- characters are allowed in comments by RM-2.1(1), 2.7(2).
1497 -- They are allowed even in Ada 83 mode according to the
1498 -- approved AI. ESC was added to the AI in June 93.
1500 elsif Source (Scan_Ptr) in Upper_Half_Character
1501 or else Source (Scan_Ptr) = ESC
1503 Scan_Ptr := Scan_Ptr + 1;
1505 -- Otherwise we have an illegal comment character
1508 Error_Illegal_Character;
1512 -- Note that, except when comments are tokens, we do NOT
1513 -- execute a return here, instead we fall through to reexecute
1514 -- the scan loop to look for a token.
1516 if Comment_Is_Token then
1517 Name_Len := Integer (Scan_Ptr - Start_Of_Comment);
1518 Name_Buffer (1 .. Name_Len) :=
1519 String (Source (Start_Of_Comment .. Scan_Ptr - 1));
1520 Comment_Id := Name_Find;
1521 Token := Tok_Comment;
1527 -- Double quote starting a string literal
1534 -- Percent starting a string literal
1537 Obsolescent_Check (Token_Ptr);
1539 if Warn_On_Obsolescent_Feature then
1541 ("use of ""'%"" is an obsolescent feature ('R'M 'J.2(4))?");
1543 ("\use """""" instead?");
1550 -- Apostrophe. This can either be the start of a character literal,
1551 -- or an isolated apostrophe used in a qualified expression or an
1552 -- attribute. We treat it as a character literal if it does not
1553 -- follow a right parenthesis, identifier, the keyword ALL or
1554 -- a literal. This means that we correctly treat constructs like:
1556 -- A := CHARACTER'('A');
1558 -- Note that RM-2.2(7) does not require a separator between
1559 -- "CHARACTER" and "'" in the above.
1561 when ''' => Char_Literal_Case : declare
1566 Accumulate_Checksum (''');
1567 Scan_Ptr := Scan_Ptr + 1;
1569 -- Here is where we make the test to distinguish the cases. Treat
1570 -- as apostrophe if previous token is an identifier, right paren
1571 -- or the reserved word "all" (latter case as in A.all'Address)
1572 -- (or the reserved word "project" in project files). Also treat
1573 -- it as apostrophe after a literal (this catches some legitimate
1574 -- cases, like A."abs"'Address, and also gives better error
1575 -- behavior for impossible cases like 123'xxx).
1577 if Prev_Token = Tok_Identifier
1578 or else Prev_Token = Tok_Right_Paren
1579 or else Prev_Token = Tok_All
1580 or else Prev_Token = Tok_Project
1581 or else Prev_Token in Token_Class_Literal
1583 Token := Tok_Apostrophe;
1584 if Style_Check then Style.Check_Apostrophe; end if;
1587 -- Otherwise the apostrophe starts a character literal
1590 -- Case of wide character literal
1592 if (Source (Scan_Ptr) = ESC
1594 Wide_Character_Encoding_Method in WC_ESC_Encoding_Method)
1596 (Source (Scan_Ptr) in Upper_Half_Character
1598 Upper_Half_Encoding)
1600 (Source (Scan_Ptr) = '['
1602 Source (Scan_Ptr + 1) = '"')
1605 Scan_Wide (Source, Scan_Ptr, Code, Err);
1606 Accumulate_Checksum (Code);
1609 Error_Illegal_Wide_Character;
1610 Code := Character'Pos (' ');
1612 -- In Ada 95 mode we allow any wide character in a character
1613 -- literal, but in Ada 2005, the set of characters allowed
1614 -- is restricted to graphic characters.
1616 elsif Ada_Version >= Ada_05
1617 and then Is_UTF_32_Non_Graphic (UTF_32 (Code))
1620 ("(Ada 2005) non-graphic character not permitted " &
1621 "in character literal", Wptr);
1624 if Source (Scan_Ptr) /= ''' then
1625 Error_Msg_S ("missing apostrophe");
1627 Scan_Ptr := Scan_Ptr + 1;
1630 -- If we do not find a closing quote in the expected place then
1631 -- assume that we have a misguided attempt at a string literal.
1633 -- However, if previous token is RANGE, then we return an
1634 -- apostrophe instead since this gives better error recovery
1636 elsif Source (Scan_Ptr + 1) /= ''' then
1637 if Prev_Token = Tok_Range then
1638 Token := Tok_Apostrophe;
1642 Scan_Ptr := Scan_Ptr - 1;
1644 ("strings are delimited by double quote character");
1650 -- Otherwise we have a (non-wide) character literal
1653 Accumulate_Checksum (Source (Scan_Ptr));
1655 if Source (Scan_Ptr) not in Graphic_Character then
1656 if Source (Scan_Ptr) in Upper_Half_Character then
1657 if Ada_Version = Ada_83 then
1658 Error_Illegal_Character;
1662 Error_Illegal_Character;
1666 Code := Get_Char_Code (Source (Scan_Ptr));
1667 Scan_Ptr := Scan_Ptr + 2;
1670 -- Fall through here with Scan_Ptr updated past the closing
1671 -- quote, and Code set to the Char_Code value for the literal
1673 Accumulate_Checksum (''');
1674 Token := Tok_Char_Literal;
1675 Set_Character_Literal_Name (Code);
1676 Token_Name := Name_Find;
1677 Character_Code := Code;
1681 end Char_Literal_Case;
1683 -- Right parenthesis
1686 Accumulate_Checksum (')');
1687 Scan_Ptr := Scan_Ptr + 1;
1688 Token := Tok_Right_Paren;
1689 if Style_Check then Style.Check_Right_Paren; end if;
1692 -- Right bracket or right brace, treated as right paren
1695 Error_Msg_S ("illegal character, replaced by "")""");
1696 Scan_Ptr := Scan_Ptr + 1;
1697 Token := Tok_Right_Paren;
1700 -- Slash (can be division operator or first character of not equal)
1703 Accumulate_Checksum ('/');
1705 if Double_Char_Token ('=') then
1706 Token := Tok_Not_Equal;
1709 Scan_Ptr := Scan_Ptr + 1;
1717 Accumulate_Checksum (';');
1718 Scan_Ptr := Scan_Ptr + 1;
1719 Token := Tok_Semicolon;
1720 if Style_Check then Style.Check_Semicolon; end if;
1725 when '|' => Vertical_Bar_Case : begin
1726 Accumulate_Checksum ('|');
1728 -- Special check for || to give nice message
1730 if Source (Scan_Ptr + 1) = '|' then
1731 Error_Msg_S ("""'|'|"" should be `OR ELSE`");
1732 Scan_Ptr := Scan_Ptr + 2;
1737 Scan_Ptr := Scan_Ptr + 1;
1738 Token := Tok_Vertical_Bar;
1739 if Style_Check then Style.Check_Vertical_Bar; end if;
1742 end Vertical_Bar_Case;
1744 -- Exclamation, replacement character for vertical bar
1746 when '!' => Exclamation_Case : begin
1747 Accumulate_Checksum ('!');
1748 Obsolescent_Check (Token_Ptr);
1750 if Warn_On_Obsolescent_Feature then
1752 ("use of ""'!"" is an obsolescent feature ('R'M 'J.2(2))?");
1754 ("\use ""'|"" instead?");
1757 if Source (Scan_Ptr + 1) = '=' then
1758 Error_Msg_S ("'!= should be /=");
1759 Scan_Ptr := Scan_Ptr + 2;
1760 Token := Tok_Not_Equal;
1764 Scan_Ptr := Scan_Ptr + 1;
1765 Token := Tok_Vertical_Bar;
1768 end Exclamation_Case;
1772 when '+' => Plus_Case : begin
1773 Accumulate_Checksum ('+');
1774 Scan_Ptr := Scan_Ptr + 1;
1779 -- Digits starting a numeric literal
1783 -- First a bit of a scan ahead to see if we have a case of an
1784 -- identifier starting with a digit (remembering exponent case).
1787 C : constant Character := Source (Scan_Ptr + 1);
1790 -- OK literal if digit followed by digit or underscore
1792 if C in '0' .. '9' or else C = '_' then
1795 -- OK literal if digit not followed by identifier char
1797 elsif not Identifier_Char (C) then
1800 -- OK literal if digit followed by e/E followed by digit/sign.
1801 -- We also allow underscore after the E, which is an error, but
1802 -- better handled by Nlit than deciding this is an identifier.
1804 elsif (C = 'e' or else C = 'E')
1805 and then (Source (Scan_Ptr + 2) in '0' .. '9'
1806 or else Source (Scan_Ptr + 2) = '+'
1807 or else Source (Scan_Ptr + 2) = '-'
1808 or else Source (Scan_Ptr + 2) = '_')
1812 -- Here we have what really looks like an identifier that
1813 -- starts with a digit, so give error msg.
1816 Error_Msg_S ("identifier may not start with digit");
1818 Underline_Found := False;
1819 Name_Buffer (1) := Source (Scan_Ptr);
1820 Accumulate_Checksum (Name_Buffer (1));
1821 Scan_Ptr := Scan_Ptr + 1;
1822 goto Scan_Identifier;
1826 -- Here we have an OK integer literal
1830 if Identifier_Char (Source (Scan_Ptr)) then
1832 ("delimiter required between literal and identifier");
1838 -- Lower case letters
1842 Underline_Found := False;
1843 Name_Buffer (1) := Source (Scan_Ptr);
1844 Accumulate_Checksum (Name_Buffer (1));
1845 Scan_Ptr := Scan_Ptr + 1;
1846 goto Scan_Identifier;
1848 -- Upper case letters
1852 Underline_Found := False;
1854 Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
1855 Accumulate_Checksum (Name_Buffer (1));
1856 Scan_Ptr := Scan_Ptr + 1;
1857 goto Scan_Identifier;
1859 -- Underline character
1862 if Special_Characters ('_') then
1863 Token_Ptr := Scan_Ptr;
1864 Scan_Ptr := Scan_Ptr + 1;
1865 Token := Tok_Special;
1866 Special_Character := '_';
1870 Error_Msg_S ("identifier cannot start with underline");
1872 Name_Buffer (1) := '_';
1873 Scan_Ptr := Scan_Ptr + 1;
1874 Underline_Found := False;
1875 goto Scan_Identifier;
1877 -- Space (not possible, because we scanned past blanks)
1880 raise Program_Error;
1882 -- Characters in top half of ASCII 8-bit chart
1884 when Upper_Half_Character =>
1886 -- Wide character case
1888 if Upper_Half_Encoding then
1889 goto Scan_Wide_Character;
1891 -- Otherwise we have OK Latin-1 character
1894 -- Upper half characters may possibly be identifier letters
1895 -- but can never be digits, so Identifier_Char can be used to
1896 -- test for a valid start of identifier character.
1898 if Identifier_Char (Source (Scan_Ptr)) then
1900 Underline_Found := False;
1901 goto Scan_Identifier;
1903 Error_Illegal_Character;
1909 -- ESC character, possible start of identifier if wide characters
1910 -- using ESC encoding are allowed in identifiers, which we can
1911 -- tell by looking at the Identifier_Char flag for ESC, which is
1912 -- only true if these conditions are met. In Ada 2005 mode, may
1913 -- also be valid UTF_32 space or line terminator character.
1915 if Identifier_Char (ESC) then
1917 goto Scan_Wide_Character;
1919 Error_Illegal_Character;
1922 -- Invalid control characters
1924 when NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | ASCII.SO |
1925 SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN |
1926 EM | FS | GS | RS | US | DEL
1928 Error_Illegal_Character;
1930 -- Invalid graphic characters
1932 when '#' | '$' | '?' | '@' | '`' | '\' | '^' | '~' =>
1934 -- If Set_Special_Character has been called for this character,
1935 -- set Scans.Special_Character and return a Special token.
1937 if Special_Characters (Source (Scan_Ptr)) then
1938 Token_Ptr := Scan_Ptr;
1939 Token := Tok_Special;
1940 Special_Character := Source (Scan_Ptr);
1941 Scan_Ptr := Scan_Ptr + 1;
1944 -- Otherwise, this is an illegal character
1947 Error_Illegal_Character;
1950 -- End switch on non-blank character
1954 -- End loop past format effectors. The exit from this loop is by
1955 -- executing a return statement following completion of token scan
1956 -- (control never falls out of this loop to the code which follows)
1960 -- Wide_Character scanning routine. On entry we have encountered the
1961 -- initial character of a wide character sequence.
1963 <<Scan_Wide_Character>>
1972 Scan_Wide (Source, Scan_Ptr, Code, Err);
1974 -- If bad wide character, signal error and continue scan
1977 Error_Illegal_Wide_Character;
1978 goto Scan_Next_Character;
1981 Cat := Get_Category (UTF_32 (Code));
1983 -- If OK letter, reset scan ptr and go scan identifier
1985 if Is_UTF_32_Letter (Cat) then
1988 Underline_Found := False;
1989 goto Scan_Identifier;
1991 -- If OK wide space, ignore and keep scanning (we do not include
1992 -- any ignored spaces in checksum)
1994 elsif Is_UTF_32_Space (Cat) then
1995 goto Scan_Next_Character;
1997 -- If OK wide line terminator, terminate current line
1999 elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then
2001 goto Scan_Line_Terminator;
2003 -- Punctuation is an error (at start of identifier)
2005 elsif Is_UTF_32_Punctuation (Cat) then
2007 ("identifier cannot start with punctuation", Wptr);
2010 Underline_Found := False;
2011 goto Scan_Identifier;
2013 -- Mark character is an error (at start of identifer)
2015 elsif Is_UTF_32_Mark (Cat) then
2017 ("identifier cannot start with mark character", Wptr);
2020 Underline_Found := False;
2021 goto Scan_Identifier;
2023 -- Other format character is an error (at start of identifer)
2025 elsif Is_UTF_32_Other (Cat) then
2027 ("identifier cannot start with other format character", Wptr);
2030 Underline_Found := False;
2031 goto Scan_Identifier;
2033 -- Extended digit character is an error. Could be bad start of
2034 -- identifier or bad literal. Not worth doing too much to try to
2035 -- distinguish these cases, but we will do a little bit.
2037 elsif Is_UTF_32_Digit (Cat) then
2039 ("identifier cannot start with digit character", Wptr);
2042 Underline_Found := False;
2043 goto Scan_Identifier;
2045 -- All other wide characters are illegal here
2048 Error_Illegal_Wide_Character;
2049 goto Scan_Next_Character;
2053 -- Routine to scan line terminator. On entry Scan_Ptr points to a
2054 -- character which is one of FF,LR,CR,VT, or one of the wide characters
2055 -- that is treated as a line termiantor.
2057 <<Scan_Line_Terminator>>
2059 -- Check line too long
2063 -- Set Token_Ptr, if End_Of_Line is a token, for the case when it is
2066 if End_Of_Line_Is_Token then
2067 Token_Ptr := Scan_Ptr;
2074 Skip_Line_Terminators (Scan_Ptr, Physical);
2076 -- If we are at start of physical line, update scan pointers to
2077 -- reflect the start of the new line.
2080 Current_Line_Start := Scan_Ptr;
2081 Start_Column := Set_Start_Column;
2082 First_Non_Blank_Location := Scan_Ptr;
2084 -- If End_Of_Line is a token, we return it as it is a
2087 if End_Of_Line_Is_Token then
2088 Token := Tok_End_Of_Line;
2094 goto Scan_Next_Character;
2096 -- Identifier scanning routine. On entry, some initial characters of
2097 -- the identifier may have already been stored in Name_Buffer. If so,
2098 -- Name_Len has the number of characters stored. otherwise Name_Len is
2099 -- set to zero on entry. Underline_Found is also set False on entry.
2103 -- This loop scans as fast as possible past lower half letters and
2104 -- digits, which we expect to be the most common characters.
2107 if Source (Scan_Ptr) in 'a' .. 'z'
2108 or else Source (Scan_Ptr) in '0' .. '9'
2110 Name_Buffer (Name_Len + 1) := Source (Scan_Ptr);
2111 Accumulate_Checksum (Source (Scan_Ptr));
2113 elsif Source (Scan_Ptr) in 'A' .. 'Z' then
2114 Name_Buffer (Name_Len + 1) :=
2115 Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
2116 Accumulate_Checksum (Name_Buffer (Name_Len + 1));
2122 Underline_Found := False;
2123 Scan_Ptr := Scan_Ptr + 1;
2124 Name_Len := Name_Len + 1;
2127 -- If we fall through, then we have encountered either an underline
2128 -- character, or an extended identifier character (i.e. one from the
2129 -- upper half), or a wide character, or an identifier terminator. The
2130 -- initial test speeds us up in the most common case where we have
2131 -- an identifier terminator. Note that ESC is an identifier character
2132 -- only if a wide character encoding method that uses ESC encoding
2133 -- is active, so if we find an ESC character we know that we have a
2136 if Identifier_Char (Source (Scan_Ptr)) then
2138 -- Case of underline
2140 if Source (Scan_Ptr) = '_' then
2141 Accumulate_Checksum ('_');
2143 if Underline_Found then
2144 Error_No_Double_Underline;
2146 Underline_Found := True;
2147 Name_Len := Name_Len + 1;
2148 Name_Buffer (Name_Len) := '_';
2151 Scan_Ptr := Scan_Ptr + 1;
2152 goto Scan_Identifier;
2154 -- Upper half character
2156 elsif Source (Scan_Ptr) in Upper_Half_Character
2157 and then not Upper_Half_Encoding
2159 Accumulate_Checksum (Source (Scan_Ptr));
2160 Store_Encoded_Character
2161 (Get_Char_Code (Fold_Lower (Source (Scan_Ptr))));
2162 Scan_Ptr := Scan_Ptr + 1;
2163 Underline_Found := False;
2164 goto Scan_Identifier;
2166 -- Left bracket not followed by a quote terminates an identifier.
2167 -- This is an error, but we don't want to give a junk error msg
2168 -- about wide characters in this case!
2170 elsif Source (Scan_Ptr) = '['
2171 and then Source (Scan_Ptr + 1) /= '"'
2175 -- We know we have a wide character encoding here (the current
2176 -- character is either ESC, left bracket, or an upper half
2177 -- character depending on the encoding method).
2180 -- Scan out the wide character and insert the appropriate
2181 -- encoding into the name table entry for the identifier.
2191 Scan_Wide (Source, Scan_Ptr, Code, Err);
2193 -- If error, signal error
2196 Error_Illegal_Wide_Character;
2198 -- If the character scanned is a normal identifier
2199 -- character, then we treat it that way.
2201 elsif In_Character_Range (Code)
2202 and then Identifier_Char (Get_Character (Code))
2204 Chr := Get_Character (Code);
2205 Accumulate_Checksum (Chr);
2206 Store_Encoded_Character
2207 (Get_Char_Code (Fold_Lower (Chr)));
2208 Underline_Found := False;
2210 -- Here if not a normal identifier character
2213 -- Make sure we are allowing wide characters in
2214 -- identifiers. Note that we allow wide character
2215 -- notation for an OK identifier character. This in
2216 -- particular allows bracket or other notation to be
2217 -- used for upper half letters.
2219 -- Wide characters are always allowed in Ada 2005
2221 if Identifier_Character_Set /= 'w'
2222 and then Ada_Version < Ada_05
2225 ("wide character not allowed in identifier", Wptr);
2228 Cat := Get_Category (UTF_32 (Code));
2230 -- If OK letter, store it folding to upper case. Note
2231 -- that we include the folded letter in the checksum.
2233 if Is_UTF_32_Letter (Cat) then
2235 Char_Code (UTF_32_To_Upper_Case (UTF_32 (Code)));
2236 Accumulate_Checksum (Code);
2237 Store_Encoded_Character (Code);
2238 Underline_Found := False;
2240 -- If OK extended digit or mark, then store it
2242 elsif Is_UTF_32_Digit (Cat)
2243 or else Is_UTF_32_Mark (Cat)
2245 Accumulate_Checksum (Code);
2246 Store_Encoded_Character (Code);
2247 Underline_Found := False;
2249 -- Wide punctuation is also stored, but counts as an
2250 -- underline character for error checking purposes.
2252 elsif Is_UTF_32_Punctuation (Cat) then
2253 Accumulate_Checksum (Code);
2255 if Underline_Found then
2257 Cend : constant Source_Ptr := Scan_Ptr;
2260 Error_No_Double_Underline;
2265 Store_Encoded_Character (Code);
2266 Underline_Found := True;
2269 -- Wide character in Unicode cateogory "Other, Format"
2270 -- is accepted in an identifier, but is ignored and not
2271 -- stored. It seems reasonable to exclude it from the
2274 -- Note that it is correct (see AI-395) to simply strip
2275 -- other format characters, before testing for double
2276 -- underlines, or for reserved words).
2278 elsif Is_UTF_32_Other (Cat) then
2281 -- Wide character in category Separator,Space terminates
2283 elsif Is_UTF_32_Space (Cat) then
2284 goto Scan_Identifier_Complete;
2286 -- Any other wide character is not acceptable
2290 ("invalid wide character in identifier", Wptr);
2294 goto Scan_Identifier;
2299 -- Scan of identifier is complete. The identifier is stored in
2300 -- Name_Buffer, and Scan_Ptr points past the last character.
2302 <<Scan_Identifier_Complete>>
2303 Token_Name := Name_Find;
2305 -- Check for identifier ending with underline or punctuation char
2307 if Underline_Found then
2308 Underline_Found := False;
2310 if Source (Scan_Ptr - 1) = '_' then
2312 ("identifier cannot end with underline", Scan_Ptr - 1);
2315 ("identifier cannot end with punctuation character", Wptr);
2319 -- Here is where we check if it was a keyword
2321 if Is_Keyword_Name (Token_Name) then
2322 Token := Token_Type'Val (Get_Name_Table_Byte (Token_Name));
2324 -- Deal with possible style check for non-lower case keyword, but
2325 -- we don't treat ACCESS, DELTA, DIGITS, RANGE as keywords for
2326 -- this purpose if they appear as attribute designators. Actually
2327 -- we only check the first character for speed.
2329 -- Ada 2005 (AI-284): Do not apply the style check in case of
2330 -- "pragma Interface"
2332 -- Ada 2005 (AI-340): Do not apply the style check in case of
2336 and then Source (Token_Ptr) <= 'Z'
2337 and then (Prev_Token /= Tok_Apostrophe
2339 (Token /= Tok_Access and then
2340 Token /= Tok_Delta and then
2341 Token /= Tok_Digits and then
2342 Token /= Tok_Mod and then
2343 Token /= Tok_Range))
2344 and then (Token /= Tok_Interface
2346 (Token = Tok_Interface
2347 and then Prev_Token /= Tok_Pragma))
2349 Style.Non_Lower_Case_Keyword;
2352 -- We must reset Token_Name since this is not an identifier and
2353 -- if we leave Token_Name set, the parser gets confused because
2354 -- it thinks it is dealing with an identifier instead of the
2355 -- corresponding keyword.
2357 Token_Name := No_Name;
2358 Accumulate_Token_Checksum;
2361 -- It is an identifier after all
2364 Token := Tok_Identifier;
2365 Accumulate_Token_Checksum;
2371 --------------------------
2372 -- Set_Comment_As_Token --
2373 --------------------------
2375 procedure Set_Comment_As_Token (Value : Boolean) is
2377 Comment_Is_Token := Value;
2378 end Set_Comment_As_Token;
2380 ------------------------------
2381 -- Set_End_Of_Line_As_Token --
2382 ------------------------------
2384 procedure Set_End_Of_Line_As_Token (Value : Boolean) is
2386 End_Of_Line_Is_Token := Value;
2387 end Set_End_Of_Line_As_Token;
2389 ---------------------------
2390 -- Set_Special_Character --
2391 ---------------------------
2393 procedure Set_Special_Character (C : Character) is
2396 when '#' | '$' | '_' | '?' | '@' | '`' | '\' | '^' | '~' =>
2397 Special_Characters (C) := True;
2402 end Set_Special_Character;
2404 ----------------------
2405 -- Set_Start_Column --
2406 ----------------------
2408 -- Note: it seems at first glance a little expensive to compute this value
2409 -- for every source line (since it is certainly not used for all source
2410 -- lines). On the other hand, it doesn't take much more work to skip past
2411 -- the initial white space on the line counting the columns than it would
2412 -- to scan past the white space using the standard scanning circuits.
2414 function Set_Start_Column return Column_Number is
2415 Start_Column : Column_Number := 0;
2418 -- Outer loop scans past horizontal tab characters
2422 -- Inner loop scans past blanks as fast as possible, bumping Scan_Ptr
2423 -- past the blanks and adjusting Start_Column to account for them.
2426 if Source (Scan_Ptr) = ' ' then
2427 if Source (Scan_Ptr + 1) = ' ' then
2428 if Source (Scan_Ptr + 2) = ' ' then
2429 if Source (Scan_Ptr + 3) = ' ' then
2430 if Source (Scan_Ptr + 4) = ' ' then
2431 if Source (Scan_Ptr + 5) = ' ' then
2432 if Source (Scan_Ptr + 6) = ' ' then
2433 Scan_Ptr := Scan_Ptr + 7;
2434 Start_Column := Start_Column + 7;
2436 Scan_Ptr := Scan_Ptr + 6;
2437 Start_Column := Start_Column + 6;
2441 Scan_Ptr := Scan_Ptr + 5;
2442 Start_Column := Start_Column + 5;
2446 Scan_Ptr := Scan_Ptr + 4;
2447 Start_Column := Start_Column + 4;
2451 Scan_Ptr := Scan_Ptr + 3;
2452 Start_Column := Start_Column + 3;
2456 Scan_Ptr := Scan_Ptr + 2;
2457 Start_Column := Start_Column + 2;
2461 Scan_Ptr := Scan_Ptr + 1;
2462 Start_Column := Start_Column + 1;
2468 end loop Blanks_Loop;
2470 -- Outer loop keeps going only if a horizontal tab follows
2472 if Source (Scan_Ptr) = HT then
2473 if Style_Check then Style.Check_HT; end if;
2474 Scan_Ptr := Scan_Ptr + 1;
2475 Start_Column := (Start_Column / 8) * 8 + 8;
2482 return Start_Column;
2484 -- A constraint error can happen only if we have a compiler with checks on
2485 -- and a line with a ludicrous number of tabs or spaces at the start. In
2486 -- such a case, we really don't care if Start_Column is right or not.
2489 when Constraint_Error =>
2490 return Start_Column;
2491 end Set_Start_Column;