-- --
-- B o d y --
-- --
--- --
--- Copyright (C) 1992-2001, Free Software Foundation, Inc.
+-- Copyright (C) 1992-2009, 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, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, 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 Uintp; use Uintp;
+with Csets; use Csets;
+with Namet.Sp; use Namet.Sp;
+with Stylesw; use Stylesw;
+with Uintp; use Uintp;
with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
end if;
for J in S'Range loop
- S (J) := Fold_Lower (Tname (Integer (J) + 4));
+ S (J) := Fold_Lower (Tname (J + 4));
end loop;
Get_Name_String (Token_Name);
Token := T;
return True;
- -- A special check for an illegal abbrevation
+ -- A special check for an illegal abbreviation
elsif Name_Len < S'Length
and then Name_Len >= 4
M2 (P2 + J - 1) := Fold_Upper (S (J));
end loop;
- Error_Msg_SC (M2 (1 .. P2 - 1 + S'Last));
+ Error_Msg_SC -- CODEFIX???
+ (M2 (1 .. P2 - 1 + S'Last));
Token := T;
return True;
end if;
and then S = Name_Buffer (1 .. SL)
then
Scan_Ptr := Token_Ptr + S'Length;
- Error_Msg_S ("missing space");
+ Error_Msg_S ("|missing space");
Token := T;
return True;
end if;
if Is_Bad_Spelling_Of (Name_Buffer (1 .. Name_Len), S) then
-
for J in 1 .. S'Last loop
M1 (P1 + J - 1) := Fold_Upper (S (J));
end loop;
- Error_Msg_SC (M1 (1 .. P1 - 1 + S'Last));
+ Error_Msg_SC -- CODFIX
+ (M1 (1 .. P1 - 1 + S'Last));
Token := T;
return True;
else
return False;
end if;
-
end Bad_Spelling_Of;
----------------------
procedure Check_Bad_Layout is
begin
- if Style.RM_Column_Check and then Token_Is_At_Start_Of_Line
+ if RM_Column_Check and then Token_Is_At_Start_Of_Line
and then Start_Column <= Scope.Table (Scope.Last).Ecol
then
- Error_Msg_BC ("(style) incorrect layout");
+ Error_Msg_BC -- CODEFIX
+ ("(style) incorrect layout");
end if;
end Check_Bad_Layout;
procedure Check_Simple_Expression_In_Ada_83 (E : Node_Id) is
begin
if Expr_Form = EF_Non_Simple then
- if Ada_83 then
+ if Ada_Version = Ada_83 then
Error_Msg_N ("(Ada 83) this expression must be parenthesized!", E);
end if;
end if;
<<Assume_Comma>>
Restore_Scan_State (Scan_State);
- Error_Msg_SC (""";"" illegal here, replaced by "",""");
+ Error_Msg_SC ("|"";"" should be "",""");
Scan; -- past the semicolon
return True;
procedure Discard_Junk_List (L : List_Id) is
pragma Warnings (Off, L);
-
begin
null;
end Discard_Junk_List;
procedure Discard_Junk_Node (N : Node_Id) is
pragma Warnings (Off, N);
-
begin
null;
end Discard_Junk_Node;
procedure Ignore (T : Token_Type) is
begin
- if Token = T then
+ while Token = T loop
if T = Tok_Comma then
- Error_Msg_SC ("unexpected "","" ignored");
+ Error_Msg_SC ("|extra "","" ignored");
elsif T = Tok_Left_Paren then
- Error_Msg_SC ("unexpected ""("" ignored");
+ Error_Msg_SC ("|extra ""("" ignored");
elsif T = Tok_Right_Paren then
- Error_Msg_SC ("unexpected "")"" ignored");
+ Error_Msg_SC ("|extra "")"" ignored");
elsif T = Tok_Semicolon then
- Error_Msg_SC ("unexpected "";"" ignored");
+ Error_Msg_SC ("|extra "";"" ignored");
+
+ elsif T = Tok_Colon then
+ Error_Msg_SC ("|extra "":"" ignored");
else
declare
Tname : constant String := Token_Type'Image (Token);
- Msg : String := "unexpected keyword ????????????????????????";
-
begin
- -- Loop to copy characters of keyword name (ignoring Tok_)
-
- for J in 5 .. Tname'Last loop
- Msg (J + 14) := Fold_Upper (Tname (J));
- end loop;
-
- Msg (Tname'Last + 15 .. Tname'Last + 22) := " ignored";
- Error_Msg_SC (Msg (1 .. Tname'Last + 22));
+ Error_Msg_SC
+ ("|extra " & Tname (5 .. Tname'Last) & "ignored");
end;
end if;
Scan; -- Scan past ignored token
- end if;
+ end loop;
end Ignore;
----------------------------
-- Is_Reserved_Identifier --
----------------------------
- function Is_Reserved_Identifier return Boolean is
+ function Is_Reserved_Identifier (C : Id_Check := None) return Boolean is
begin
if not Is_Reserved_Keyword (Token) then
return False;
declare
Ident_Casing : constant Casing_Type :=
Identifier_Casing (Current_Source_File);
-
Key_Casing : constant Casing_Type :=
Keyword_Casing (Current_Source_File);
-- keyword casing, then we return False, since it is pretty
-- clearly intended to be a keyword.
- if Ident_Casing /= Unknown
- and then Key_Casing /= Unknown
- and then Ident_Casing /= Key_Casing
- and then Determine_Token_Casing = Key_Casing
+ if Ident_Casing = Unknown
+ or else Key_Casing = Unknown
+ or else Ident_Casing = Key_Casing
+ or else Determine_Token_Casing /= Key_Casing
then
- return False;
+ return True;
- -- Otherwise assume that an identifier was intended
+ -- Here we have a keyword written clearly with keyword casing.
+ -- In default mode, we would not be willing to consider this as
+ -- a reserved identifier, but if C is set, we may still accept it
- else
- return True;
+ elsif C /= None then
+ declare
+ Scan_State : Saved_Scan_State;
+ OK_Next_Tok : Boolean;
+
+ begin
+ Save_Scan_State (Scan_State);
+ Scan;
+
+ if Token_Is_At_Start_Of_Line then
+ return False;
+ end if;
+
+ case C is
+ when None =>
+ raise Program_Error;
+
+ when C_Comma_Right_Paren =>
+ OK_Next_Tok :=
+ Token = Tok_Comma or else Token = Tok_Right_Paren;
+
+ when C_Comma_Colon =>
+ OK_Next_Tok :=
+ Token = Tok_Comma or else Token = Tok_Colon;
+
+ when C_Do =>
+ OK_Next_Tok :=
+ Token = Tok_Do;
+
+ when C_Dot =>
+ OK_Next_Tok :=
+ Token = Tok_Dot;
+
+ when C_Greater_Greater =>
+ OK_Next_Tok :=
+ Token = Tok_Greater_Greater;
+
+ when C_In =>
+ OK_Next_Tok :=
+ Token = Tok_In;
+
+ when C_Is =>
+ OK_Next_Tok :=
+ Token = Tok_Is;
+
+ when C_Left_Paren_Semicolon =>
+ OK_Next_Tok :=
+ Token = Tok_Left_Paren or else Token = Tok_Semicolon;
+
+ when C_Use =>
+ OK_Next_Tok :=
+ Token = Tok_Use;
+
+ when C_Vertical_Bar_Arrow =>
+ OK_Next_Tok :=
+ Token = Tok_Vertical_Bar or else Token = Tok_Arrow;
+ end case;
+
+ Restore_Scan_State (Scan_State);
+
+ if OK_Next_Tok then
+ return True;
+ end if;
+ end;
end if;
end;
end if;
+
+ -- If we fall through it is not a reserved identifier
+
+ return False;
end Is_Reserved_Identifier;
----------------------
Get_Name_String (Chars (Token_Node));
declare
- Buf : String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
+ Buf : constant String (1 .. Name_Len) :=
+ Name_Buffer (1 .. Name_Len);
begin
Get_Name_String (Chars (Prev));
end Merge_Identifier;
-------------------
+ -- Next_Token_Is --
+ -------------------
+
+ function Next_Token_Is (Tok : Token_Type) return Boolean is
+ Scan_State : Saved_Scan_State;
+ Result : Boolean;
+ begin
+ Save_Scan_State (Scan_State);
+ Scan;
+ Result := (Token = Tok);
+ Restore_Scan_State (Scan_State);
+ return Result;
+ end Next_Token_Is;
+
+ -------------------
-- No_Constraint --
-------------------
end if;
end No_Constraint;
- --------------------
- -- No_Right_Paren --
- --------------------
-
- function No_Right_Paren (Expr : Node_Id) return Node_Id is
- begin
- if Token = Tok_Right_Paren then
- Error_Msg_SC ("unexpected right parenthesis");
- Resync_Expression;
- return Error;
- else
- return Expr;
- end if;
- end No_Right_Paren;
-
---------------------
-- Pop_Scope_Stack --
---------------------
procedure Push_Scope_Stack is
begin
Scope.Increment_Last;
+
+ if Style_Check_Max_Nesting_Level
+ and then Scope.Last = Style_Max_Nesting_Level + 1
+ then
+ Error_Msg
+ ("(style) maximum nesting level exceeded",
+ First_Non_Blank_Location);
+ end if;
+
Scope.Table (Scope.Last).Junk := False;
Scope.Table (Scope.Last).Node := Empty;
-- Check for possible misspelling
- Get_Name_String (Token_Name);
+ Error_Msg_Name_1 := First_Attribute_Name;
+ while Error_Msg_Name_1 <= Last_Attribute_Name loop
+ if Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1) then
+ Error_Msg_N -- CODEFIX
+ ("\possible misspelling of %", Token_Node);
+ exit;
+ end if;
- declare
- AN : constant String := Name_Buffer (1 .. Name_Len);
+ Error_Msg_Name_1 := Error_Msg_Name_1 + 1;
+ end loop;
+ end Signal_Bad_Attribute;
- begin
- Error_Msg_Name_1 := First_Attribute_Name;
- while Error_Msg_Name_1 <= Last_Attribute_Name loop
- Get_Name_String (Error_Msg_Name_1);
+ -----------------------------
+ -- Token_Is_At_End_Of_Line --
+ -----------------------------
- if Is_Bad_Spelling_Of
- (AN, Name_Buffer (1 .. Name_Len))
- then
- Error_Msg_N
- ("\possible misspelling of %", Token_Node);
- exit;
- end if;
+ function Token_Is_At_End_Of_Line return Boolean is
+ S : Source_Ptr;
- Error_Msg_Name_1 := Error_Msg_Name_1 + 1;
- end loop;
- end;
- end Signal_Bad_Attribute;
+ begin
+ -- Skip past blanks and horizontal tabs
+
+ S := Scan_Ptr;
+ while Source (S) = ' ' or else Source (S) = ASCII.HT loop
+ S := S + 1;
+ end loop;
+
+ -- We are at end of line if at a control character (CR/LF/VT/FF/EOF)
+ -- or if we are at the start of an end of line comment sequence.
+
+ return Source (S) < ' '
+ or else (Source (S) = '-' and then Source (S + 1) = '-');
+ end Token_Is_At_End_Of_Line;
-------------------------------
-- Token_Is_At_Start_Of_Line --
OSDN Git Service
