-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
with Widechar; use Widechar;
with System.CRC32;
+with System.UTF_32; use System.UTF_32;
with System.WCh_Con; use System.WCh_Con;
-with GNAT.UTF_32; use GNAT.UTF_32;
-
package body Scng is
use ASCII;
Error_Long_Line;
end if;
+ -- Now one more checking circuit. Normally we are only enforcing a
+ -- limit of physical characters, with tabs counting as one character.
+ -- But if after tab expansion we would have a total line length that
+ -- exceeded 32766, that would really cause trouble, because column
+ -- positions would exceed the maximum we allow for a column count.
+ -- Note: the limit is 32766 rather than 32767, since we use a value
+ -- of 32767 for special purposes (see Sinput). Now we really do not
+ -- want to go messing with tabs in the normal case, so what we do is
+ -- to check for a line that has more than 4096 physical characters.
+ -- Any shorter line could not be a problem, even if it was all tabs.
+
+ if Len >= 4096 then
+ declare
+ Col : Natural;
+ Ptr : Source_Ptr;
+
+ begin
+ Col := 1;
+ Ptr := Current_Line_Start;
+ loop
+ exit when Ptr = Scan_Ptr;
+
+ if Source (Ptr) = ASCII.HT then
+ Col := (Col - 1 + 8) / 8 * 8 + 1;
+ else
+ Col := Col + 1;
+ end if;
+
+ if Col > 32766 then
+ Error_Msg
+ ("this line is longer than 32766 characters",
+ Current_Line_Start);
+ raise Unrecoverable_Error;
+ end if;
+
+ Ptr := Ptr + 1;
+ end loop;
+ end;
+ end if;
+
-- Reset wide character byte count for next line
Wide_Char_Byte_Count := 0;
UI_Int_Value := Uint_0;
Scale := 0;
Scan_Integer;
- Scale := 0;
Point_Scanned := False;
UI_Num_Value := UI_Int_Value;
if Warn_On_Obsolescent_Feature then
Error_Msg_S
- ("use of "":"" is an obsolescent feature ('R'M 'J.2(3))?");
+ ("use of "":"" is an obsolescent feature (RM J.2(3))?");
Error_Msg_S
("\use ""'#"" instead?");
end if;
-- Horizontal tab, just skip past it
when HT =>
- if Style_Check then Style.Check_HT; end if;
+ if Style_Check then
+ Style.Check_HT;
+ end if;
+
Scan_Ptr := Scan_Ptr + 1;
-- End of file character, treated as an end of file only if it is
when EOF =>
if Scan_Ptr = Source_Last (Current_Source_File) then
Check_End_Of_Line;
- if Style_Check then Style.Check_EOF; end if;
+
+ if Style_Check then
+ Style.Check_EOF;
+ end if;
+
Token := Tok_EOF;
return;
else
if Double_Char_Token ('=') then
Token := Tok_Colon_Equal;
- if Style_Check then Style.Check_Colon_Equal; end if;
+
+ if Style_Check then
+ Style.Check_Colon_Equal;
+ end if;
+
return;
elsif Source (Scan_Ptr + 1) = '-'
else
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Colon;
- if Style_Check then Style.Check_Colon; end if;
+
+ if Style_Check then
+ Style.Check_Colon;
+ end if;
+
return;
end if;
Accumulate_Checksum ('(');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Left_Paren;
- if Style_Check then Style.Check_Left_Paren; end if;
+
+ if Style_Check then
+ Style.Check_Left_Paren;
+ end if;
+
return;
-- Left bracket
Accumulate_Checksum (',');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Comma;
- if Style_Check then Style.Check_Comma; end if;
+
+ if Style_Check then
+ Style.Check_Comma;
+ end if;
+
return;
-- Dot, which is either an isolated period, or part of a double dot
if Double_Char_Token ('.') then
Token := Tok_Dot_Dot;
- if Style_Check then Style.Check_Dot_Dot; end if;
+
+ if Style_Check then
+ Style.Check_Dot_Dot;
+ end if;
+
return;
elsif Source (Scan_Ptr + 1) in '0' .. '9' then
if Double_Char_Token ('>') then
Token := Tok_Arrow;
- if Style_Check then Style.Check_Arrow; end if;
+
+ if Style_Check then
+ Style.Check_Arrow;
+ end if;
+
return;
elsif Source (Scan_Ptr + 1) = '=' then
elsif Double_Char_Token ('>') then
Token := Tok_Box;
- if Style_Check then Style.Check_Box; end if;
+
+ if Style_Check then
+ Style.Check_Box;
+ end if;
+
return;
elsif Double_Char_Token ('<') then
-- Comment
else -- Source (Scan_Ptr + 1) = '-' then
- if Style_Check then Style.Check_Comment; end if;
+ if Style_Check then
+ Style.Check_Comment;
+ end if;
+
Scan_Ptr := Scan_Ptr + 2;
-- If we are in preprocessor mode with Replace_In_Comments set,
-- Keep going if horizontal tab
if Source (Scan_Ptr) = HT then
- if Style_Check then Style.Check_HT; end if;
+ if Style_Check then
+ Style.Check_HT;
+ end if;
+
Scan_Ptr := Scan_Ptr + 1;
-- Terminate scan of comment if line terminator
if Warn_On_Obsolescent_Feature then
Error_Msg_S
- ("use of ""'%"" is an obsolescent feature ('R'M 'J.2(4))?");
+ ("use of ""'%"" is an obsolescent feature (RM J.2(4))?");
Error_Msg_S
("\use """""" instead?");
end if;
or else Prev_Token in Token_Class_Literal
then
Token := Tok_Apostrophe;
- if Style_Check then Style.Check_Apostrophe; end if;
+
+ if Style_Check then
+ Style.Check_Apostrophe;
+ end if;
+
return;
-- Otherwise the apostrophe starts a character literal
Accumulate_Checksum (')');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Right_Paren;
- if Style_Check then Style.Check_Right_Paren; end if;
+
+ if Style_Check then
+ Style.Check_Right_Paren;
+ end if;
+
return;
-- Right bracket or right brace, treated as right paren
Accumulate_Checksum (';');
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Semicolon;
- if Style_Check then Style.Check_Semicolon; end if;
+
+ if Style_Check then
+ Style.Check_Semicolon;
+ end if;
+
return;
-- Vertical bar
else
Scan_Ptr := Scan_Ptr + 1;
Token := Tok_Vertical_Bar;
- if Style_Check then Style.Check_Vertical_Bar; end if;
+
+ if Style_Check then
+ Style.Check_Vertical_Bar;
+ end if;
+
return;
end if;
end Vertical_Bar_Case;
if Warn_On_Obsolescent_Feature then
Error_Msg_S
- ("use of ""'!"" is an obsolescent feature ('R'M 'J.2(2))?");
+ ("use of ""'!"" is an obsolescent feature (RM J.2(2))?");
Error_Msg_S
("\use ""'|"" instead?");
end if;
-- Digits starting a numeric literal
when '0' .. '9' =>
+
+ -- First a bit of a scan ahead to see if we have a case of an
+ -- identifier starting with a digit (remembering exponent case).
+
+ declare
+ C : constant Character := Source (Scan_Ptr + 1);
+
+ begin
+ -- OK literal if digit followed by digit or underscore
+
+ if C in '0' .. '9' or else C = '_' then
+ null;
+
+ -- OK literal if digit not followed by identifier char
+
+ elsif not Identifier_Char (C) then
+ null;
+
+ -- OK literal if digit followed by e/E followed by digit/sign.
+ -- We also allow underscore after the E, which is an error, but
+ -- better handled by Nlit than deciding this is an identifier.
+
+ elsif (C = 'e' or else C = 'E')
+ and then (Source (Scan_Ptr + 2) in '0' .. '9'
+ or else Source (Scan_Ptr + 2) = '+'
+ or else Source (Scan_Ptr + 2) = '-'
+ or else Source (Scan_Ptr + 2) = '_')
+ then
+ null;
+
+ -- Here we have what really looks like an identifier that
+ -- starts with a digit, so give error msg.
+
+ else
+ Error_Msg_S ("identifier may not start with digit");
+ Name_Len := 1;
+ Underline_Found := False;
+ Name_Buffer (1) := Source (Scan_Ptr);
+ Accumulate_Checksum (Name_Buffer (1));
+ Scan_Ptr := Scan_Ptr + 1;
+ goto Scan_Identifier;
+ end if;
+ end;
+
+ -- Here we have an OK integer literal
+
Nlit;
if Identifier_Char (Source (Scan_Ptr)) then
Error_Msg_S
("delimiter required between literal and identifier");
end if;
+
Post_Scan;
return;
if Is_Keyword_Name (Token_Name) then
Token := Token_Type'Val (Get_Name_Table_Byte (Token_Name));
- -- Deal with possible style check for non-lower case keyword, but
- -- we don't treat ACCESS, DELTA, DIGITS, RANGE as keywords for
- -- this purpose if they appear as attribute designators. Actually
- -- we only check the first character for speed.
-
- -- Ada 2005 (AI-284): Do not apply the style check in case of
- -- "pragma Interface"
-
- -- Ada 2005 (AI-340): Do not apply the style check in case of
- -- MOD attribute.
-
- if Style_Check
- and then Source (Token_Ptr) <= 'Z'
- and then (Prev_Token /= Tok_Apostrophe
- or else
- (Token /= Tok_Access and then
- Token /= Tok_Delta and then
- Token /= Tok_Digits and then
- Token /= Tok_Mod and then
- Token /= Tok_Range))
- and then (Token /= Tok_Interface
- or else
- (Token = Tok_Interface
- and then Prev_Token /= Tok_Pragma))
- then
- Style.Non_Lower_Case_Keyword;
+ -- Keyword style checks
+
+ if Style_Check then
+
+ -- Deal with possible style check for non-lower case keyword,
+ -- but we don't treat ACCESS, DELTA, DIGITS, RANGE as keywords
+ -- for this purpose if they appear as attribute designators.
+ -- Actually we only check the first character for speed.
+
+ -- Ada 2005 (AI-284): Do not apply the style check in case of
+ -- "pragma Interface"
+
+ -- Ada 2005 (AI-340): Do not apply the style check in case of
+ -- MOD attribute.
+
+ if Source (Token_Ptr) <= 'Z'
+ and then (Prev_Token /= Tok_Apostrophe
+ or else
+ (Token /= Tok_Access and then
+ Token /= Tok_Delta and then
+ Token /= Tok_Digits and then
+ Token /= Tok_Mod and then
+ Token /= Tok_Range))
+ and then (Token /= Tok_Interface
+ or else
+ (Token = Tok_Interface
+ and then Prev_Token /= Tok_Pragma))
+ then
+ Style.Non_Lower_Case_Keyword;
+ end if;
+
+ if (Token = Tok_Then and then Prev_Token /= Tok_And)
+ or else
+ (Token = Tok_Else and then Prev_Token /= Tok_Or)
+ then
+ Style.Check_Separate_Stmt_Lines;
+ end if;
end if;
-- We must reset Token_Name since this is not an identifier and
-- Outer loop keeps going only if a horizontal tab follows
if Source (Scan_Ptr) = HT then
- if Style_Check then Style.Check_HT; end if;
+ if Style_Check then
+ Style.Check_HT;
+ end if;
+
Scan_Ptr := Scan_Ptr + 1;
Start_Column := (Start_Column / 8) * 8 + 8;
else
end loop Tabs_Loop;
return Start_Column;
+
+ -- A constraint error can happen only if we have a compiler with checks on
+ -- and a line with a ludicrous number of tabs or spaces at the start. In
+ -- such a case, we really don't care if Start_Column is right or not.
+
+ exception
+ when Constraint_Error =>
+ return Start_Column;
end Set_Start_Column;
end Scng;
OSDN Git Service
