1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2009, 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
;
41 with System
.UTF_32
; use System
.UTF_32
;
42 with System
.WCh_Con
; use System
.WCh_Con
;
47 -- Make control characters visible
49 Special_Characters
: array (Character) of Boolean := (others => False);
50 -- For characters that are Special token, the value is True
52 Comment_Is_Token
: Boolean := False;
53 -- True if comments are tokens
55 End_Of_Line_Is_Token
: Boolean := False;
56 -- True if End_Of_Line is a token
58 -----------------------
59 -- Local Subprograms --
60 -----------------------
62 procedure Accumulate_Token_Checksum
;
63 pragma Inline
(Accumulate_Token_Checksum
);
65 procedure Accumulate_Checksum
(C
: Character);
66 pragma Inline
(Accumulate_Checksum
);
67 -- This routine accumulates the checksum given character C. During the
68 -- scanning of a source file, this routine is called with every character
69 -- in the source, excluding blanks, and all control characters (except
70 -- that ESC is included in the checksum). Upper case letters not in string
71 -- literals are folded by the caller. See Sinput spec for the documentation
72 -- of the checksum algorithm. Note: checksum values are only used if we
73 -- generate code, so it is not necessary to worry about making the right
74 -- sequence of calls in any error situation.
76 procedure Accumulate_Checksum
(C
: Char_Code
);
77 pragma Inline
(Accumulate_Checksum
);
78 -- This version is identical, except that the argument, C, is a character
79 -- code value instead of a character. This is used when wide characters
80 -- are scanned. We use the character code rather than the ASCII characters
81 -- so that the checksum is independent of wide character encoding method.
83 procedure Initialize_Checksum
;
84 pragma Inline
(Initialize_Checksum
);
85 -- Initialize checksum value
87 -------------------------
88 -- Accumulate_Checksum --
89 -------------------------
91 procedure Accumulate_Checksum
(C
: Character) is
93 System
.CRC32
.Update
(System
.CRC32
.CRC32
(Checksum
), C
);
94 end Accumulate_Checksum
;
96 procedure Accumulate_Checksum
(C
: Char_Code
) is
99 Accumulate_Checksum
(Character'Val (C
/ 2 ** 24));
100 Accumulate_Checksum
(Character'Val ((C
/ 2 ** 16) mod 256));
101 Accumulate_Checksum
(Character'Val ((C
/ 256) mod 256));
103 Accumulate_Checksum
(Character'Val (C
/ 256));
106 Accumulate_Checksum
(Character'Val (C
mod 256));
107 end Accumulate_Checksum
;
109 -------------------------------
110 -- Accumulate_Token_Checksum --
111 -------------------------------
113 procedure Accumulate_Token_Checksum
is
116 (System
.CRC32
.CRC32
(Checksum
),
117 Character'Val (Token_Type
'Pos (Token
)));
118 end Accumulate_Token_Checksum
;
120 ----------------------------
121 -- Determine_Token_Casing --
122 ----------------------------
124 function Determine_Token_Casing
return Casing_Type
is
126 return Determine_Casing
(Source
(Token_Ptr
.. Scan_Ptr
- 1));
127 end Determine_Token_Casing
;
129 -------------------------
130 -- Initialize_Checksum --
131 -------------------------
133 procedure Initialize_Checksum
is
135 System
.CRC32
.Initialize
(System
.CRC32
.CRC32
(Checksum
));
136 end Initialize_Checksum
;
138 ------------------------
139 -- Initialize_Scanner --
140 ------------------------
142 procedure Initialize_Scanner
(Index
: Source_File_Index
) is
144 -- Establish reserved words
146 Scans
.Initialize_Ada_Keywords
;
148 -- Initialize scan control variables
150 Current_Source_File
:= Index
;
151 Source
:= Source_Text
(Current_Source_File
);
152 Scan_Ptr
:= Source_First
(Current_Source_File
);
154 Token_Ptr
:= Scan_Ptr
;
155 Current_Line_Start
:= Scan_Ptr
;
157 Token_Name
:= No_Name
;
158 Start_Column
:= Set_Start_Column
;
159 First_Non_Blank_Location
:= Scan_Ptr
;
162 Wide_Char_Byte_Count
:= 0;
164 -- Do not call Scan, otherwise the License stuff does not work in Scn
166 end Initialize_Scanner
;
168 ------------------------------
169 -- Reset_Special_Characters --
170 ------------------------------
172 procedure Reset_Special_Characters
is
174 Special_Characters
:= (others => False);
175 end Reset_Special_Characters
;
183 Start_Of_Comment
: Source_Ptr
;
184 -- Record start of comment position
186 Underline_Found
: Boolean;
187 -- During scanning of an identifier, set to True if last character
188 -- scanned was an underline or other punctuation character. This
189 -- is used to flag the error of two underlines/punctuations in a
190 -- row or ending an identifier with a underline/punctuation. Here
191 -- punctuation means any UTF_32 character in the Unicode category
192 -- Punctuation,Connector.
195 -- Used to remember start of last wide character scanned
197 procedure Check_End_Of_Line
;
198 -- Called when end of line encountered. Checks that line is not too
199 -- long, and that other style checks for the end of line are met.
201 function Double_Char_Token
(C
: Character) return Boolean;
202 -- This function is used for double character tokens like := or <>. It
203 -- checks if the character following Source (Scan_Ptr) is C, and if so
204 -- bumps Scan_Ptr past the pair of characters and returns True. A space
205 -- between the two characters is also recognized with an appropriate
206 -- error message being issued. If C is not present, False is returned.
207 -- Note that Double_Char_Token can only be used for tokens defined in
208 -- the Ada syntax (it's use for error cases like && is not appropriate
209 -- since we do not want a junk message for a case like &-space-&).
211 procedure Error_Illegal_Character
;
212 -- Give illegal character error, Scan_Ptr points to character. On
213 -- return, Scan_Ptr is bumped past the illegal character.
215 procedure Error_Illegal_Wide_Character
;
216 -- Give illegal wide character message. On return, Scan_Ptr is bumped
217 -- past the illegal character, which may still leave us pointing to
218 -- junk, not much we can do if the escape sequence is messed up!
220 procedure Error_Long_Line
;
221 -- Signal error of excessively long line
223 procedure Error_No_Double_Underline
;
224 -- Signal error of two underline or punctuation characters in a row.
225 -- Called with Scan_Ptr pointing to second underline/punctuation char.
228 -- This is the procedure for scanning out numeric literals. On entry,
229 -- Scan_Ptr points to the digit that starts the numeric literal (the
230 -- checksum for this character has not been accumulated yet). On return
231 -- Scan_Ptr points past the last character of the numeric literal, Token
232 -- and Token_Node are set appropriately, and the checksum is updated.
235 -- This is the procedure for scanning out string literals. On entry,
236 -- Scan_Ptr points to the opening string quote (the checksum for this
237 -- character has not been accumulated yet). On return Scan_Ptr points
238 -- past the closing quote of the string literal, Token and Token_Node
239 -- are set appropriately, and the checksum is updated.
241 -----------------------
242 -- Check_End_Of_Line --
243 -----------------------
245 procedure Check_End_Of_Line
is
246 Len
: constant Int
:=
248 Int
(Current_Line_Start
) -
249 Wide_Char_Byte_Count
;
253 Style
.Check_Line_Terminator
(Len
);
256 -- Deal with checking maximum line length
258 if Style_Check
and Style_Check_Max_Line_Length
then
259 Style
.Check_Line_Max_Length
(Len
);
261 -- If style checking is inactive, check maximum line length against
264 elsif Len
> Max_Line_Length
then
268 -- Now one more checking circuit. Normally we are only enforcing a
269 -- limit of physical characters, with tabs counting as one character.
270 -- But if after tab expansion we would have a total line length that
271 -- exceeded 32766, that would really cause trouble, because column
272 -- positions would exceed the maximum we allow for a column count.
273 -- Note: the limit is 32766 rather than 32767, since we use a value
274 -- of 32767 for special purposes (see Sinput). Now we really do not
275 -- want to go messing with tabs in the normal case, so what we do is
276 -- to check for a line that has more than 4096 physical characters.
277 -- Any shorter line could not be a problem, even if it was all tabs.
286 Ptr
:= Current_Line_Start
;
288 exit when Ptr
= Scan_Ptr
;
290 if Source
(Ptr
) = ASCII
.HT
then
291 Col
:= (Col
- 1 + 8) / 8 * 8 + 1;
298 ("this line is longer than 32766 characters",
300 raise Unrecoverable_Error
;
308 -- Reset wide character byte count for next line
310 Wide_Char_Byte_Count
:= 0;
311 end Check_End_Of_Line
;
313 -----------------------
314 -- Double_Char_Token --
315 -----------------------
317 function Double_Char_Token
(C
: Character) return Boolean is
319 if Source
(Scan_Ptr
+ 1) = C
then
320 Accumulate_Checksum
(C
);
321 Scan_Ptr
:= Scan_Ptr
+ 2;
324 elsif Source
(Scan_Ptr
+ 1) = ' '
325 and then Source
(Scan_Ptr
+ 2) = C
327 Scan_Ptr
:= Scan_Ptr
+ 1;
328 Error_Msg_S
("no space allowed here");
329 Scan_Ptr
:= Scan_Ptr
+ 2;
335 end Double_Char_Token
;
337 -----------------------------
338 -- Error_Illegal_Character --
339 -----------------------------
341 procedure Error_Illegal_Character
is
343 Error_Msg_S
("illegal character");
344 Scan_Ptr
:= Scan_Ptr
+ 1;
345 end Error_Illegal_Character
;
347 ----------------------------------
348 -- Error_Illegal_Wide_Character --
349 ----------------------------------
351 procedure Error_Illegal_Wide_Character
is
353 Scan_Ptr
:= Scan_Ptr
+ 1;
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
380 Error_Msg_S
-- CODEFIX
381 ("two consecutive underlines not permitted");
383 Error_Msg_S
-- CODEFIX???
384 ("underline cannot follow punctuation character");
388 if Source
(Scan_Ptr
- 1) = '_' then
389 Error_Msg_S
-- CODEFIX???
390 ("punctuation character cannot follow underline");
392 Error_Msg_S
-- CODEFIX???
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 (RM 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
1185 Scan_Ptr
:= Scan_Ptr
+ 1;
1187 -- End of file character, treated as an end of file only if it is
1188 -- the last character in the buffer, otherwise it is ignored.
1191 if Scan_Ptr
= Source_Last
(Current_Source_File
) then
1201 Scan_Ptr
:= Scan_Ptr
+ 1;
1207 Accumulate_Checksum
('&');
1209 if Source
(Scan_Ptr
+ 1) = '&' then
1210 Error_Msg_S
("'&'& should be `AND THEN`");
1211 Scan_Ptr
:= Scan_Ptr
+ 2;
1216 Scan_Ptr
:= Scan_Ptr
+ 1;
1217 Token
:= Tok_Ampersand
;
1221 -- Asterisk (can be multiplication operator or double asterisk which
1222 -- is the exponentiation compound delimiter).
1225 Accumulate_Checksum
('*');
1227 if Source
(Scan_Ptr
+ 1) = '*' then
1228 Accumulate_Checksum
('*');
1229 Scan_Ptr
:= Scan_Ptr
+ 2;
1230 Token
:= Tok_Double_Asterisk
;
1234 Scan_Ptr
:= Scan_Ptr
+ 1;
1235 Token
:= Tok_Asterisk
;
1239 -- Colon, which can either be an isolated colon, or part of an
1240 -- assignment compound delimiter.
1243 Accumulate_Checksum
(':');
1245 if Double_Char_Token
('=') then
1246 Token
:= Tok_Colon_Equal
;
1249 Style
.Check_Colon_Equal
;
1254 elsif Source
(Scan_Ptr
+ 1) = '-'
1255 and then Source
(Scan_Ptr
+ 2) /= '-'
1257 Token
:= Tok_Colon_Equal
;
1258 Error_Msg
(":- should be :=", Scan_Ptr
);
1259 Scan_Ptr
:= Scan_Ptr
+ 2;
1263 Scan_Ptr
:= Scan_Ptr
+ 1;
1276 Accumulate_Checksum
('(');
1277 Scan_Ptr
:= Scan_Ptr
+ 1;
1278 Token
:= Tok_Left_Paren
;
1281 Style
.Check_Left_Paren
;
1289 if Source
(Scan_Ptr
+ 1) = '"' then
1290 goto Scan_Wide_Character
;
1293 Error_Msg_S
("illegal character, replaced by ""(""");
1294 Scan_Ptr
:= Scan_Ptr
+ 1;
1295 Token
:= Tok_Left_Paren
;
1302 Error_Msg_S
("illegal character, replaced by ""(""");
1303 Scan_Ptr
:= Scan_Ptr
+ 1;
1304 Token
:= Tok_Left_Paren
;
1310 Accumulate_Checksum
(',');
1311 Scan_Ptr
:= Scan_Ptr
+ 1;
1320 -- Dot, which is either an isolated period, or part of a double dot
1321 -- compound delimiter sequence. We also check for the case of a
1322 -- digit following the period, to give a better error message.
1325 Accumulate_Checksum
('.');
1327 if Double_Char_Token
('.') then
1328 Token
:= Tok_Dot_Dot
;
1331 Style
.Check_Dot_Dot
;
1336 elsif Source
(Scan_Ptr
+ 1) in '0' .. '9' then
1337 Error_Msg_S
("numeric literal cannot start with point");
1338 Scan_Ptr
:= Scan_Ptr
+ 1;
1341 Scan_Ptr
:= Scan_Ptr
+ 1;
1346 -- Equal, which can either be an equality operator, or part of the
1347 -- arrow (=>) compound delimiter.
1350 Accumulate_Checksum
('=');
1352 if Double_Char_Token
('>') then
1361 elsif Source
(Scan_Ptr
+ 1) = '=' then
1362 Error_Msg_S
("== should be =");
1363 Scan_Ptr
:= Scan_Ptr
+ 1;
1366 Scan_Ptr
:= Scan_Ptr
+ 1;
1370 -- Greater than, which can be a greater than operator, greater than
1371 -- or equal operator, or first character of a right label bracket.
1374 Accumulate_Checksum
('>');
1376 if Double_Char_Token
('=') then
1377 Token
:= Tok_Greater_Equal
;
1380 elsif Double_Char_Token
('>') then
1381 Token
:= Tok_Greater_Greater
;
1385 Scan_Ptr
:= Scan_Ptr
+ 1;
1386 Token
:= Tok_Greater
;
1390 -- Less than, which can be a less than operator, less than or equal
1391 -- operator, or the first character of a left label bracket, or the
1392 -- first character of a box (<>) compound delimiter.
1395 Accumulate_Checksum
('<');
1397 if Double_Char_Token
('=') then
1398 Token
:= Tok_Less_Equal
;
1401 elsif Double_Char_Token
('>') then
1410 elsif Double_Char_Token
('<') then
1411 Token
:= Tok_Less_Less
;
1415 Scan_Ptr
:= Scan_Ptr
+ 1;
1420 -- Minus, which is either a subtraction operator, or the first
1421 -- character of double minus starting a comment
1423 when '-' => Minus_Case
: begin
1424 if Source
(Scan_Ptr
+ 1) = '>' then
1425 Error_Msg_S
("invalid token");
1426 Scan_Ptr
:= Scan_Ptr
+ 2;
1430 elsif Source
(Scan_Ptr
+ 1) /= '-' then
1431 Accumulate_Checksum
('-');
1432 Scan_Ptr
:= Scan_Ptr
+ 1;
1438 else -- Source (Scan_Ptr + 1) = '-' then
1440 Style
.Check_Comment
;
1443 Scan_Ptr
:= Scan_Ptr
+ 2;
1445 -- If we are in preprocessor mode with Replace_In_Comments set,
1446 -- then we return the "--" as a token on its own.
1448 if Replace_In_Comments
then
1449 Token
:= Tok_Comment
;
1453 -- Otherwise scan out the comment
1455 Start_Of_Comment
:= Scan_Ptr
;
1457 -- Loop to scan comment (this loop runs more than once only if
1458 -- a horizontal tab or other non-graphic character is scanned)
1461 -- Scan to non graphic character (opened up for speed)
1463 -- Note that we just eat left brackets, which means that
1464 -- bracket notation cannot be used for end of line
1465 -- characters in comments. This seems a reasonable choice,
1466 -- since no one would ever use brackets notation in a real
1467 -- program in this situation, and if we allow brackets
1468 -- notation, we forbid some valid comments which contain a
1469 -- brackets sequence that happens to match an end of line
1473 exit when Source
(Scan_Ptr
) not in Graphic_Character
;
1474 Scan_Ptr
:= Scan_Ptr
+ 1;
1475 exit when Source
(Scan_Ptr
) not in Graphic_Character
;
1476 Scan_Ptr
:= Scan_Ptr
+ 1;
1477 exit when Source
(Scan_Ptr
) not in Graphic_Character
;
1478 Scan_Ptr
:= Scan_Ptr
+ 1;
1479 exit when Source
(Scan_Ptr
) not in Graphic_Character
;
1480 Scan_Ptr
:= Scan_Ptr
+ 1;
1481 exit when Source
(Scan_Ptr
) not in Graphic_Character
;
1482 Scan_Ptr
:= Scan_Ptr
+ 1;
1485 -- Keep going if horizontal tab
1487 if Source
(Scan_Ptr
) = HT
then
1492 Scan_Ptr
:= Scan_Ptr
+ 1;
1494 -- Terminate scan of comment if line terminator
1496 elsif Source
(Scan_Ptr
) in Line_Terminator
then
1499 -- Terminate scan of comment if end of file encountered
1500 -- (embedded EOF character or real last character in file)
1502 elsif Source
(Scan_Ptr
) = EOF
then
1505 -- If we have a wide character, we have to scan it out,
1506 -- because it might be a legitimate line terminator
1508 elsif (Source
(Scan_Ptr
) = ESC
1509 and then Identifier_Char
(ESC
))
1511 (Source
(Scan_Ptr
) in Upper_Half_Character
1512 and then Upper_Half_Encoding
)
1515 Wptr
: constant Source_Ptr
:= Scan_Ptr
;
1520 Scan_Wide
(Source
, Scan_Ptr
, Code
, Err
);
1522 -- If not well formed wide character, then just skip
1523 -- past it and ignore it.
1526 Scan_Ptr
:= Wptr
+ 1;
1528 -- If UTF_32 terminator, terminate comment scan
1530 elsif Is_UTF_32_Line_Terminator
(UTF_32
(Code
)) then
1536 -- Keep going if character in 80-FF range, or is ESC. These
1537 -- characters are allowed in comments by RM-2.1(1), 2.7(2).
1538 -- They are allowed even in Ada 83 mode according to the
1539 -- approved AI. ESC was added to the AI in June 93.
1541 elsif Source
(Scan_Ptr
) in Upper_Half_Character
1542 or else Source
(Scan_Ptr
) = ESC
1544 Scan_Ptr
:= Scan_Ptr
+ 1;
1546 -- Otherwise we have an illegal comment character
1549 Error_Illegal_Character
;
1553 -- Note that, except when comments are tokens, we do NOT
1554 -- execute a return here, instead we fall through to reexecute
1555 -- the scan loop to look for a token.
1557 if Comment_Is_Token
then
1558 Name_Len
:= Integer (Scan_Ptr
- Start_Of_Comment
);
1559 Name_Buffer
(1 .. Name_Len
) :=
1560 String (Source
(Start_Of_Comment
.. Scan_Ptr
- 1));
1561 Comment_Id
:= Name_Find
;
1562 Token
:= Tok_Comment
;
1568 -- Double quote starting a string literal
1575 -- Percent starting a string literal
1578 Obsolescent_Check
(Token_Ptr
);
1580 if Warn_On_Obsolescent_Feature
then
1582 ("use of ""'%"" is an obsolescent feature (RM J.2(4))?");
1584 ("\use """""" instead?");
1591 -- Apostrophe. This can either be the start of a character literal,
1592 -- or an isolated apostrophe used in a qualified expression or an
1593 -- attribute. We treat it as a character literal if it does not
1594 -- follow a right parenthesis, identifier, the keyword ALL or
1595 -- a literal. This means that we correctly treat constructs like:
1597 -- A := CHARACTER'('A');
1599 -- Note that RM-2.2(7) does not require a separator between
1600 -- "CHARACTER" and "'" in the above.
1602 when ''' => Char_Literal_Case
: declare
1607 Accumulate_Checksum
(''');
1608 Scan_Ptr
:= Scan_Ptr
+ 1;
1610 -- Here is where we make the test to distinguish the cases. Treat
1611 -- as apostrophe if previous token is an identifier, right paren
1612 -- or the reserved word "all" (latter case as in A.all'Address)
1613 -- (or the reserved word "project" in project files). Also treat
1614 -- it as apostrophe after a literal (this catches some legitimate
1615 -- cases, like A."abs"'Address, and also gives better error
1616 -- behavior for impossible cases like 123'xxx).
1618 if Prev_Token
= Tok_Identifier
1619 or else Prev_Token
= Tok_Right_Paren
1620 or else Prev_Token
= Tok_All
1621 or else Prev_Token
= Tok_Project
1622 or else Prev_Token
in Token_Class_Literal
1624 Token
:= Tok_Apostrophe
;
1627 Style
.Check_Apostrophe
;
1632 -- Otherwise the apostrophe starts a character literal
1635 -- Case of wide character literal
1637 if (Source
(Scan_Ptr
) = ESC
1639 Wide_Character_Encoding_Method
in WC_ESC_Encoding_Method
)
1641 (Source
(Scan_Ptr
) in Upper_Half_Character
1643 Upper_Half_Encoding
)
1645 (Source
(Scan_Ptr
) = '['
1647 Source
(Scan_Ptr
+ 1) = '"')
1650 Scan_Wide
(Source
, Scan_Ptr
, Code
, Err
);
1651 Accumulate_Checksum
(Code
);
1654 Error_Illegal_Wide_Character
;
1655 Code
:= Character'Pos (' ');
1657 -- In Ada 95 mode we allow any wide character in a character
1658 -- literal, but in Ada 2005, the set of characters allowed
1659 -- is restricted to graphic characters.
1661 elsif Ada_Version
>= Ada_05
1662 and then Is_UTF_32_Non_Graphic
(UTF_32
(Code
))
1665 ("(Ada 2005) non-graphic character not permitted " &
1666 "in character literal", Wptr
);
1669 if Source
(Scan_Ptr
) /= ''' then
1670 Error_Msg_S
("missing apostrophe");
1672 Scan_Ptr
:= Scan_Ptr
+ 1;
1675 -- If we do not find a closing quote in the expected place then
1676 -- assume that we have a misguided attempt at a string literal.
1678 -- However, if previous token is RANGE, then we return an
1679 -- apostrophe instead since this gives better error recovery
1681 elsif Source
(Scan_Ptr
+ 1) /= ''' then
1682 if Prev_Token
= Tok_Range
then
1683 Token
:= Tok_Apostrophe
;
1687 Scan_Ptr
:= Scan_Ptr
- 1;
1689 ("strings are delimited by double quote character");
1695 -- Otherwise we have a (non-wide) character literal
1698 Accumulate_Checksum
(Source
(Scan_Ptr
));
1700 if Source
(Scan_Ptr
) not in Graphic_Character
then
1701 if Source
(Scan_Ptr
) in Upper_Half_Character
then
1702 if Ada_Version
= Ada_83
then
1703 Error_Illegal_Character
;
1707 Error_Illegal_Character
;
1711 Code
:= Get_Char_Code
(Source
(Scan_Ptr
));
1712 Scan_Ptr
:= Scan_Ptr
+ 2;
1715 -- Fall through here with Scan_Ptr updated past the closing
1716 -- quote, and Code set to the Char_Code value for the literal
1718 Accumulate_Checksum
(''');
1719 Token
:= Tok_Char_Literal
;
1720 Set_Character_Literal_Name
(Code
);
1721 Token_Name
:= Name_Find
;
1722 Character_Code
:= Code
;
1726 end Char_Literal_Case
;
1728 -- Right parenthesis
1731 Accumulate_Checksum
(')');
1732 Scan_Ptr
:= Scan_Ptr
+ 1;
1733 Token
:= Tok_Right_Paren
;
1736 Style
.Check_Right_Paren
;
1741 -- Right bracket or right brace, treated as right paren
1744 Error_Msg_S
("illegal character, replaced by "")""");
1745 Scan_Ptr
:= Scan_Ptr
+ 1;
1746 Token
:= Tok_Right_Paren
;
1749 -- Slash (can be division operator or first character of not equal)
1752 Accumulate_Checksum
('/');
1754 if Double_Char_Token
('=') then
1755 Token
:= Tok_Not_Equal
;
1758 Scan_Ptr
:= Scan_Ptr
+ 1;
1766 Accumulate_Checksum
(';');
1767 Scan_Ptr
:= Scan_Ptr
+ 1;
1768 Token
:= Tok_Semicolon
;
1771 Style
.Check_Semicolon
;
1778 when '|' => Vertical_Bar_Case
: begin
1779 Accumulate_Checksum
('|');
1781 -- Special check for || to give nice message
1783 if Source
(Scan_Ptr
+ 1) = '|' then
1784 Error_Msg_S
("""'|'|"" should be `OR ELSE`");
1785 Scan_Ptr
:= Scan_Ptr
+ 2;
1790 Scan_Ptr
:= Scan_Ptr
+ 1;
1791 Token
:= Tok_Vertical_Bar
;
1794 Style
.Check_Vertical_Bar
;
1799 end Vertical_Bar_Case
;
1801 -- Exclamation, replacement character for vertical bar
1803 when '!' => Exclamation_Case
: begin
1804 Accumulate_Checksum
('!');
1805 Obsolescent_Check
(Token_Ptr
);
1807 if Warn_On_Obsolescent_Feature
then
1809 ("use of ""'!"" is an obsolescent feature (RM J.2(2))?");
1811 ("\use ""'|"" instead?");
1814 if Source
(Scan_Ptr
+ 1) = '=' then
1815 Error_Msg_S
("'!= should be /=");
1816 Scan_Ptr
:= Scan_Ptr
+ 2;
1817 Token
:= Tok_Not_Equal
;
1821 Scan_Ptr
:= Scan_Ptr
+ 1;
1822 Token
:= Tok_Vertical_Bar
;
1825 end Exclamation_Case
;
1829 when '+' => Plus_Case
: begin
1830 Accumulate_Checksum
('+');
1831 Scan_Ptr
:= Scan_Ptr
+ 1;
1836 -- Digits starting a numeric literal
1840 -- First a bit of a scan ahead to see if we have a case of an
1841 -- identifier starting with a digit (remembering exponent case).
1844 C
: constant Character := Source
(Scan_Ptr
+ 1);
1847 -- OK literal if digit followed by digit or underscore
1849 if C
in '0' .. '9' or else C
= '_' then
1852 -- OK literal if digit not followed by identifier char
1854 elsif not Identifier_Char
(C
) then
1857 -- OK literal if digit followed by e/E followed by digit/sign.
1858 -- We also allow underscore after the E, which is an error, but
1859 -- better handled by Nlit than deciding this is an identifier.
1861 elsif (C
= 'e' or else C
= 'E')
1862 and then (Source
(Scan_Ptr
+ 2) in '0' .. '9'
1863 or else Source
(Scan_Ptr
+ 2) = '+'
1864 or else Source
(Scan_Ptr
+ 2) = '-'
1865 or else Source
(Scan_Ptr
+ 2) = '_')
1869 -- Here we have what really looks like an identifier that
1870 -- starts with a digit, so give error msg.
1873 Error_Msg_S
("identifier may not start with digit");
1875 Underline_Found
:= False;
1876 Name_Buffer
(1) := Source
(Scan_Ptr
);
1877 Accumulate_Checksum
(Name_Buffer
(1));
1878 Scan_Ptr
:= Scan_Ptr
+ 1;
1879 goto Scan_Identifier
;
1883 -- Here we have an OK integer literal
1887 if Identifier_Char
(Source
(Scan_Ptr
)) then
1889 ("delimiter required between literal and identifier");
1895 -- Lower case letters
1899 Underline_Found
:= False;
1900 Name_Buffer
(1) := Source
(Scan_Ptr
);
1901 Accumulate_Checksum
(Name_Buffer
(1));
1902 Scan_Ptr
:= Scan_Ptr
+ 1;
1903 goto Scan_Identifier
;
1905 -- Upper case letters
1909 Underline_Found
:= False;
1911 Character'Val (Character'Pos (Source
(Scan_Ptr
)) + 32);
1912 Accumulate_Checksum
(Name_Buffer
(1));
1913 Scan_Ptr
:= Scan_Ptr
+ 1;
1914 goto Scan_Identifier
;
1916 -- Underline character
1919 if Special_Characters
('_') then
1920 Token_Ptr
:= Scan_Ptr
;
1921 Scan_Ptr
:= Scan_Ptr
+ 1;
1922 Token
:= Tok_Special
;
1923 Special_Character
:= '_';
1927 Error_Msg_S
("identifier cannot start with underline");
1929 Name_Buffer
(1) := '_';
1930 Scan_Ptr
:= Scan_Ptr
+ 1;
1931 Underline_Found
:= False;
1932 goto Scan_Identifier
;
1934 -- Space (not possible, because we scanned past blanks)
1937 raise Program_Error
;
1939 -- Characters in top half of ASCII 8-bit chart
1941 when Upper_Half_Character
=>
1943 -- Wide character case
1945 if Upper_Half_Encoding
then
1946 goto Scan_Wide_Character
;
1948 -- Otherwise we have OK Latin-1 character
1951 -- Upper half characters may possibly be identifier letters
1952 -- but can never be digits, so Identifier_Char can be used to
1953 -- test for a valid start of identifier character.
1955 if Identifier_Char
(Source
(Scan_Ptr
)) then
1957 Underline_Found
:= False;
1958 goto Scan_Identifier
;
1960 Error_Illegal_Character
;
1966 -- ESC character, possible start of identifier if wide characters
1967 -- using ESC encoding are allowed in identifiers, which we can
1968 -- tell by looking at the Identifier_Char flag for ESC, which is
1969 -- only true if these conditions are met. In Ada 2005 mode, may
1970 -- also be valid UTF_32 space or line terminator character.
1972 if Identifier_Char
(ESC
) then
1974 goto Scan_Wide_Character
;
1976 Error_Illegal_Character
;
1979 -- Invalid control characters
1981 when NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | ASCII
.SO |
1982 SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN |
1983 EM | FS | GS | RS | US | DEL
1985 Error_Illegal_Character
;
1987 -- Invalid graphic characters
1989 when '#' |
'$' |
'?' |
'@' |
'`' |
'\' |
'^' |
'~' =>
1991 -- If Set_Special_Character has been called for this character,
1992 -- set Scans.Special_Character and return a Special token.
1994 if Special_Characters
(Source
(Scan_Ptr
)) then
1995 Token_Ptr
:= Scan_Ptr
;
1996 Token
:= Tok_Special
;
1997 Special_Character
:= Source
(Scan_Ptr
);
1998 Scan_Ptr
:= Scan_Ptr
+ 1;
2001 -- Otherwise, this is an illegal character
2004 Error_Illegal_Character
;
2007 -- End switch on non-blank character
2011 -- End loop past format effectors. The exit from this loop is by
2012 -- executing a return statement following completion of token scan
2013 -- (control never falls out of this loop to the code which follows)
2017 -- Wide_Character scanning routine. On entry we have encountered the
2018 -- initial character of a wide character sequence.
2020 <<Scan_Wide_Character
>>
2029 Scan_Wide
(Source
, Scan_Ptr
, Code
, Err
);
2031 -- If bad wide character, signal error and continue scan
2034 Error_Illegal_Wide_Character
;
2035 goto Scan_Next_Character
;
2038 Cat
:= Get_Category
(UTF_32
(Code
));
2040 -- If OK letter, reset scan ptr and go scan identifier
2042 if Is_UTF_32_Letter
(Cat
) then
2045 Underline_Found
:= False;
2046 goto Scan_Identifier
;
2048 -- If OK wide space, ignore and keep scanning (we do not include
2049 -- any ignored spaces in checksum)
2051 elsif Is_UTF_32_Space
(Cat
) then
2052 goto Scan_Next_Character
;
2054 -- If OK wide line terminator, terminate current line
2056 elsif Is_UTF_32_Line_Terminator
(UTF_32
(Code
)) then
2058 goto Scan_Line_Terminator
;
2060 -- Punctuation is an error (at start of identifier)
2062 elsif Is_UTF_32_Punctuation
(Cat
) then
2064 ("identifier cannot start with punctuation", Wptr
);
2067 Underline_Found
:= False;
2068 goto Scan_Identifier
;
2070 -- Mark character is an error (at start of identifier)
2072 elsif Is_UTF_32_Mark
(Cat
) then
2074 ("identifier cannot start with mark character", Wptr
);
2077 Underline_Found
:= False;
2078 goto Scan_Identifier
;
2080 -- Other format character is an error (at start of identifier)
2082 elsif Is_UTF_32_Other
(Cat
) then
2084 ("identifier cannot start with other format character", Wptr
);
2087 Underline_Found
:= False;
2088 goto Scan_Identifier
;
2090 -- Extended digit character is an error. Could be bad start of
2091 -- identifier or bad literal. Not worth doing too much to try to
2092 -- distinguish these cases, but we will do a little bit.
2094 elsif Is_UTF_32_Digit
(Cat
) then
2096 ("identifier cannot start with digit character", Wptr
);
2099 Underline_Found
:= False;
2100 goto Scan_Identifier
;
2102 -- All other wide characters are illegal here
2105 Error_Illegal_Wide_Character
;
2106 goto Scan_Next_Character
;
2110 -- Routine to scan line terminator. On entry Scan_Ptr points to a
2111 -- character which is one of FF,LR,CR,VT, or one of the wide characters
2112 -- that is treated as a line terminator.
2114 <<Scan_Line_Terminator
>>
2116 -- Check line too long
2120 -- Set Token_Ptr, if End_Of_Line is a token, for the case when it is
2123 if End_Of_Line_Is_Token
then
2124 Token_Ptr
:= Scan_Ptr
;
2131 Skip_Line_Terminators
(Scan_Ptr
, Physical
);
2133 -- If we are at start of physical line, update scan pointers to
2134 -- reflect the start of the new line.
2137 Current_Line_Start
:= Scan_Ptr
;
2138 Start_Column
:= Set_Start_Column
;
2139 First_Non_Blank_Location
:= Scan_Ptr
;
2141 -- If End_Of_Line is a token, we return it as it is a
2144 if End_Of_Line_Is_Token
then
2145 Token
:= Tok_End_Of_Line
;
2151 goto Scan_Next_Character
;
2153 -- Identifier scanning routine. On entry, some initial characters of
2154 -- the identifier may have already been stored in Name_Buffer. If so,
2155 -- Name_Len has the number of characters stored, otherwise Name_Len is
2156 -- set to zero on entry. Underline_Found is also set False on entry.
2160 -- This loop scans as fast as possible past lower half letters and
2161 -- digits, which we expect to be the most common characters.
2164 if Source
(Scan_Ptr
) in 'a' .. 'z'
2165 or else Source
(Scan_Ptr
) in '0' .. '9'
2167 Name_Buffer
(Name_Len
+ 1) := Source
(Scan_Ptr
);
2168 Accumulate_Checksum
(Source
(Scan_Ptr
));
2170 elsif Source
(Scan_Ptr
) in 'A' .. 'Z' then
2171 Name_Buffer
(Name_Len
+ 1) :=
2172 Character'Val (Character'Pos (Source
(Scan_Ptr
)) + 32);
2173 Accumulate_Checksum
(Name_Buffer
(Name_Len
+ 1));
2179 Underline_Found
:= False;
2180 Scan_Ptr
:= Scan_Ptr
+ 1;
2181 Name_Len
:= Name_Len
+ 1;
2184 -- If we fall through, then we have encountered either an underline
2185 -- character, or an extended identifier character (i.e. one from the
2186 -- upper half), or a wide character, or an identifier terminator. The
2187 -- initial test speeds us up in the most common case where we have
2188 -- an identifier terminator. Note that ESC is an identifier character
2189 -- only if a wide character encoding method that uses ESC encoding
2190 -- is active, so if we find an ESC character we know that we have a
2193 if Identifier_Char
(Source
(Scan_Ptr
))
2194 or else (Source
(Scan_Ptr
) in Upper_Half_Character
2195 and then Upper_Half_Encoding
)
2197 -- Case of underline
2199 if Source
(Scan_Ptr
) = '_' then
2200 Accumulate_Checksum
('_');
2202 if Underline_Found
then
2203 Error_No_Double_Underline
;
2205 Underline_Found
:= True;
2206 Name_Len
:= Name_Len
+ 1;
2207 Name_Buffer
(Name_Len
) := '_';
2210 Scan_Ptr
:= Scan_Ptr
+ 1;
2211 goto Scan_Identifier
;
2213 -- Upper half character
2215 elsif Source
(Scan_Ptr
) in Upper_Half_Character
2216 and then not Upper_Half_Encoding
2218 Accumulate_Checksum
(Source
(Scan_Ptr
));
2219 Store_Encoded_Character
2220 (Get_Char_Code
(Fold_Lower
(Source
(Scan_Ptr
))));
2221 Scan_Ptr
:= Scan_Ptr
+ 1;
2222 Underline_Found
:= False;
2223 goto Scan_Identifier
;
2225 -- Left bracket not followed by a quote terminates an identifier.
2226 -- This is an error, but we don't want to give a junk error msg
2227 -- about wide characters in this case!
2229 elsif Source
(Scan_Ptr
) = '['
2230 and then Source
(Scan_Ptr
+ 1) /= '"'
2234 -- We know we have a wide character encoding here (the current
2235 -- character is either ESC, left bracket, or an upper half
2236 -- character depending on the encoding method).
2239 -- Scan out the wide character and insert the appropriate
2240 -- encoding into the name table entry for the identifier.
2250 Scan_Wide
(Source
, Scan_Ptr
, Code
, Err
);
2252 -- If error, signal error
2255 Error_Illegal_Wide_Character
;
2257 -- If the character scanned is a normal identifier
2258 -- character, then we treat it that way.
2260 elsif In_Character_Range
(Code
)
2261 and then Identifier_Char
(Get_Character
(Code
))
2263 Chr
:= Get_Character
(Code
);
2264 Accumulate_Checksum
(Chr
);
2265 Store_Encoded_Character
2266 (Get_Char_Code
(Fold_Lower
(Chr
)));
2267 Underline_Found
:= False;
2269 -- Here if not a normal identifier character
2272 -- Make sure we are allowing wide characters in
2273 -- identifiers. Note that we allow wide character
2274 -- notation for an OK identifier character. This in
2275 -- particular allows bracket or other notation to be
2276 -- used for upper half letters.
2278 -- Wide characters are always allowed in Ada 2005
2280 if Identifier_Character_Set
/= 'w'
2281 and then Ada_Version
< Ada_05
2284 ("wide character not allowed in identifier", Wptr
);
2287 Cat
:= Get_Category
(UTF_32
(Code
));
2289 -- If OK letter, store it folding to upper case. Note
2290 -- that we include the folded letter in the checksum.
2292 if Is_UTF_32_Letter
(Cat
) then
2294 Char_Code
(UTF_32_To_Upper_Case
(UTF_32
(Code
)));
2295 Accumulate_Checksum
(Code
);
2296 Store_Encoded_Character
(Code
);
2297 Underline_Found
:= False;
2299 -- If OK extended digit or mark, then store it
2301 elsif Is_UTF_32_Digit
(Cat
)
2302 or else Is_UTF_32_Mark
(Cat
)
2304 Accumulate_Checksum
(Code
);
2305 Store_Encoded_Character
(Code
);
2306 Underline_Found
:= False;
2308 -- Wide punctuation is also stored, but counts as an
2309 -- underline character for error checking purposes.
2311 elsif Is_UTF_32_Punctuation
(Cat
) then
2312 Accumulate_Checksum
(Code
);
2314 if Underline_Found
then
2316 Cend
: constant Source_Ptr
:= Scan_Ptr
;
2319 Error_No_Double_Underline
;
2324 Store_Encoded_Character
(Code
);
2325 Underline_Found
:= True;
2328 -- Wide character in Unicode category "Other, Format"
2329 -- is accepted in an identifier, but is ignored and not
2330 -- stored. It seems reasonable to exclude it from the
2333 -- Note that it is correct (see AI-395) to simply strip
2334 -- other format characters, before testing for double
2335 -- underlines, or for reserved words).
2337 elsif Is_UTF_32_Other
(Cat
) then
2340 -- Wide character in category Separator,Space terminates
2342 elsif Is_UTF_32_Space
(Cat
) then
2343 goto Scan_Identifier_Complete
;
2345 -- Any other wide character is not acceptable
2349 ("invalid wide character in identifier", Wptr
);
2353 goto Scan_Identifier
;
2358 -- Scan of identifier is complete. The identifier is stored in
2359 -- Name_Buffer, and Scan_Ptr points past the last character.
2361 <<Scan_Identifier_Complete
>>
2362 Token_Name
:= Name_Find
;
2364 -- Check for identifier ending with underline or punctuation char
2366 if Underline_Found
then
2367 Underline_Found
:= False;
2369 if Source
(Scan_Ptr
- 1) = '_' then
2371 ("identifier cannot end with underline", Scan_Ptr
- 1);
2374 ("identifier cannot end with punctuation character", Wptr
);
2378 -- Here is where we check if it was a keyword
2380 if Is_Keyword_Name
(Token_Name
) then
2381 Token
:= Token_Type
'Val (Get_Name_Table_Byte
(Token_Name
));
2383 -- Keyword style checks
2387 -- Deal with possible style check for non-lower case keyword,
2388 -- but we don't treat ACCESS, DELTA, DIGITS, RANGE as keywords
2389 -- for this purpose if they appear as attribute designators.
2390 -- Actually we only check the first character for speed.
2392 -- Ada 2005 (AI-284): Do not apply the style check in case of
2393 -- "pragma Interface"
2395 -- Ada 2005 (AI-340): Do not apply the style check in case of
2398 if Source
(Token_Ptr
) <= 'Z'
2399 and then (Prev_Token
/= Tok_Apostrophe
2401 (Token
/= Tok_Access
and then
2402 Token
/= Tok_Delta
and then
2403 Token
/= Tok_Digits
and then
2404 Token
/= Tok_Mod
and then
2405 Token
/= Tok_Range
))
2406 and then (Token
/= Tok_Interface
2408 (Token
= Tok_Interface
2409 and then Prev_Token
/= Tok_Pragma
))
2411 Style
.Non_Lower_Case_Keyword
;
2414 if (Token
= Tok_Then
and then Prev_Token
/= Tok_And
)
2416 (Token
= Tok_Else
and then Prev_Token
/= Tok_Or
)
2418 Style
.Check_Separate_Stmt_Lines
;
2422 -- We must reset Token_Name since this is not an identifier and
2423 -- if we leave Token_Name set, the parser gets confused because
2424 -- it thinks it is dealing with an identifier instead of the
2425 -- corresponding keyword.
2427 Token_Name
:= No_Name
;
2428 Accumulate_Token_Checksum
;
2431 -- It is an identifier after all
2434 Token
:= Tok_Identifier
;
2435 Accumulate_Token_Checksum
;
2441 --------------------------
2442 -- Set_Comment_As_Token --
2443 --------------------------
2445 procedure Set_Comment_As_Token
(Value
: Boolean) is
2447 Comment_Is_Token
:= Value
;
2448 end Set_Comment_As_Token
;
2450 ------------------------------
2451 -- Set_End_Of_Line_As_Token --
2452 ------------------------------
2454 procedure Set_End_Of_Line_As_Token
(Value
: Boolean) is
2456 End_Of_Line_Is_Token
:= Value
;
2457 end Set_End_Of_Line_As_Token
;
2459 ---------------------------
2460 -- Set_Special_Character --
2461 ---------------------------
2463 procedure Set_Special_Character
(C
: Character) is
2466 when '#' |
'$' |
'_' |
'?' |
'@' |
'`' |
'\' |
'^' |
'~' =>
2467 Special_Characters
(C
) := True;
2472 end Set_Special_Character
;
2474 ----------------------
2475 -- Set_Start_Column --
2476 ----------------------
2478 -- Note: it seems at first glance a little expensive to compute this value
2479 -- for every source line (since it is certainly not used for all source
2480 -- lines). On the other hand, it doesn't take much more work to skip past
2481 -- the initial white space on the line counting the columns than it would
2482 -- to scan past the white space using the standard scanning circuits.
2484 function Set_Start_Column
return Column_Number
is
2485 Start_Column
: Column_Number
:= 0;
2488 -- Outer loop scans past horizontal tab characters
2492 -- Inner loop scans past blanks as fast as possible, bumping Scan_Ptr
2493 -- past the blanks and adjusting Start_Column to account for them.
2496 if Source
(Scan_Ptr
) = ' ' then
2497 if Source
(Scan_Ptr
+ 1) = ' ' then
2498 if Source
(Scan_Ptr
+ 2) = ' ' then
2499 if Source
(Scan_Ptr
+ 3) = ' ' then
2500 if Source
(Scan_Ptr
+ 4) = ' ' then
2501 if Source
(Scan_Ptr
+ 5) = ' ' then
2502 if Source
(Scan_Ptr
+ 6) = ' ' then
2503 Scan_Ptr
:= Scan_Ptr
+ 7;
2504 Start_Column
:= Start_Column
+ 7;
2506 Scan_Ptr
:= Scan_Ptr
+ 6;
2507 Start_Column
:= Start_Column
+ 6;
2511 Scan_Ptr
:= Scan_Ptr
+ 5;
2512 Start_Column
:= Start_Column
+ 5;
2516 Scan_Ptr
:= Scan_Ptr
+ 4;
2517 Start_Column
:= Start_Column
+ 4;
2521 Scan_Ptr
:= Scan_Ptr
+ 3;
2522 Start_Column
:= Start_Column
+ 3;
2526 Scan_Ptr
:= Scan_Ptr
+ 2;
2527 Start_Column
:= Start_Column
+ 2;
2531 Scan_Ptr
:= Scan_Ptr
+ 1;
2532 Start_Column
:= Start_Column
+ 1;
2538 end loop Blanks_Loop
;
2540 -- Outer loop keeps going only if a horizontal tab follows
2542 if Source
(Scan_Ptr
) = HT
then
2547 Scan_Ptr
:= Scan_Ptr
+ 1;
2548 Start_Column
:= (Start_Column
/ 8) * 8 + 8;
2555 return Start_Column
;
2557 -- A constraint error can happen only if we have a compiler with checks on
2558 -- and a line with a ludicrous number of tabs or spaces at the start. In
2559 -- such a case, we really don't care if Start_Column is right or not.
2562 when Constraint_Error
=>
2563 return Start_Column
;
2564 end Set_Start_Column
;