-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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 Stringt; use Stringt;
-with Uintp; use Uintp;
+with Namet.Sp; use Namet.Sp;
+with Stringt; use Stringt;
+with Uintp; use Uintp;
with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
-- child unit or a node with a Chars field identifying the actual label.
End_Labl_Present : Boolean;
- -- Indicates that the value in End_Labl was for an explicit label.
+ -- Indicates that the value in End_Labl was for an explicit label
Syntax_OK : Boolean;
-- Set True if the entry is syntactically correct
-- Local Subprograms --
-----------------------
- procedure Evaluate_End_Entry (SS_Index : Int);
+ procedure Evaluate_End_Entry (SS_Index : Nat);
-- Compare scanned END entry (as recorded by a prior call to P_End_Scan)
-- with a specified entry in the scope stack (the single parameter is the
-- entry index in the scope stack). Note that Scan is not called. The above
-- variables xxx_OK are set to indicate the result of the evaluation.
+ function Explicit_Start_Label (SS_Index : Nat) return Boolean;
+ -- Determines whether the specified entry in the scope stack has an
+ -- explicit start label (i.e. one other than one that was created by
+ -- the parser when no explicit label was present)
+
procedure Output_End_Deleted;
-- Output a message complaining that the current END structure does not
-- match anything and is being deleted.
-- Check_End --
---------------
- function Check_End return Boolean is
+ function Check_End (Decl : Node_Id := Empty) return Boolean is
Name_On_Separate_Line : Boolean;
-- Set True if the name on an END line is on a separate source line
-- from the END. This is highly suspicious, but is allowed. The point
End_Type := E_Record;
Scan; -- past RECORD
+ elsif Token = Tok_Return then
+ End_Type := E_Return;
+ Scan; -- past RETURN
+
elsif Token = Tok_Select then
End_Type := E_Select;
Scan; -- past SELECT
-- opening label, with the components all marked as not
-- from source, and Is_End_Label set in the identifier
-- or operator symbol. The location for all components
- -- is the curent token location.
+ -- is the current token location.
-- Case of child unit name
if Nkind (End_Labl) = N_Defining_Program_Unit_Name then
- declare
+ Child_End : declare
Eref : constant Node_Id :=
Make_Identifier (Token_Ptr,
Chars =>
function Copy_Name (N : Node_Id) return Node_Id;
-- Copies a selected component or identifier
+ ---------------
+ -- Copy_Name --
+ ---------------
+
function Copy_Name (N : Node_Id) return Node_Id is
R : Node_Id;
Copy_Name (Selector_Name (N)));
else
- R :=
- Make_Identifier (Token_Ptr,
- Chars => Chars (N));
+ R := Make_Identifier (Token_Ptr, Chars (N));
Set_Comes_From_Source (N, False);
return R;
end if;
end Copy_Name;
+ -- Start of processing for Child_End
+
begin
Set_Comes_From_Source (Eref, False);
Make_Designator (Token_Ptr,
Name => Copy_Name (Name (End_Labl)),
Identifier => Eref);
- end;
+ end Child_End;
-- Simple identifier case
elsif Nkind (End_Labl) = N_Defining_Identifier
or else Nkind (End_Labl) = N_Identifier
then
- End_Labl :=
- Make_Identifier (Token_Ptr,
- Chars => Chars (End_Labl));
+ End_Labl := Make_Identifier (Token_Ptr, Chars (End_Labl));
elsif Nkind (End_Labl) = N_Defining_Operator_Symbol
or else Nkind (End_Labl) = N_Operator_Symbol
Set_Comes_From_Source (End_Labl, False);
End_Labl_Present := False;
+ -- In SPARK mode, no missing label is allowed
+
+ if SPARK_Mode
+ and then End_Type = E_Name
+ and then Explicit_Start_Label (Scope.Last)
+ then
+ Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
+ Formal_Error_Msg_SP -- CODEFIX
+ ("`END &` required");
+ end if;
+
-- Do style check for missing label
if Style_Check
and then End_Type = E_Name
- and then Present (Scope.Table (Scope.Last).Labl)
+ and then Explicit_Start_Label (Scope.Last)
then
Style.No_End_Name (Scope.Table (Scope.Last).Labl);
end if;
end if;
end if;
- -- Except in case of END RECORD, semicolon must follow. For END
- -- RECORD, a semicolon does follow, but it is part of a higher level
- -- construct. In any case, a missing semicolon is not serious enough
- -- to consider the END statement to be bad in the sense that we
- -- are dealing with (i.e. to be suspicious that it is not in fact
- -- the END statement we are looking for!)
+ -- Deal with terminating aspect specifications and following semi-
+ -- colon. We skip this in the case of END RECORD, since in this
+ -- case the aspect specifications and semicolon are handled at
+ -- a higher level.
if End_Type /= E_Record then
- if Token = Tok_Semicolon then
- T_Semicolon;
-
- -- Semicolon is missing. If the missing semicolon is at the end
- -- of the line, i.e. we are at the start of the line now, then
- -- a missing semicolon gets flagged, but is not serious enough
- -- to consider the END statement to be bad in the sense that we
- -- are dealing with (i.e. to be suspicious that this END is not
- -- the END statement we are looking for).
-
- -- Similarly, if we are at a colon, we flag it but a colon for
- -- a semicolon is not serious enough to consider the END to be
- -- incorrect. Same thing for a period in place of a semicolon.
-
- elsif Token_Is_At_Start_Of_Line
- or else Token = Tok_Colon
- or else Token = Tok_Dot
- then
- T_Semicolon;
- -- If the missing semicolon is not at the start of the line,
- -- then we do consider the END line to be dubious in this sense.
+ -- Scan aspect specifications if permitted here
- else
- End_OK := False;
+ if Aspect_Specifications_Present then
+ if No (Decl) then
+ P_Aspect_Specifications (Error);
+ else
+ P_Aspect_Specifications (Decl);
+ end if;
+
+ -- If no aspect specifications, must have a semicolon
+
+ elsif End_Type /= E_Record then
+ if Token = Tok_Semicolon then
+ T_Semicolon;
+
+ -- Semicolon is missing. If the missing semicolon is at the end
+ -- of the line, i.e. we are at the start of the line now, then
+ -- a missing semicolon gets flagged, but is not serious enough
+ -- to consider the END statement to be bad in the sense that we
+ -- are dealing with (i.e. to be suspicious that this END is not
+ -- the END statement we are looking for).
+
+ -- Similarly, if we are at a colon, we flag it but a colon for
+ -- a semicolon is not serious enough to consider the END to be
+ -- incorrect. Same thing for a period in place of a semicolon.
+
+ elsif Token_Is_At_Start_Of_Line
+ or else Token = Tok_Colon
+ or else Token = Tok_Dot
+ then
+ T_Semicolon;
+
+ -- If the missing semicolon is not at the start of the line,
+ -- then we consider the END line to be dubious in this sense.
+
+ else
+ End_OK := False;
+ end if;
end if;
end if;
end if;
-- Error recovery: cannot raise Error_Resync;
- procedure End_Statements (Parent : Node_Id := Empty) is
+ procedure End_Statements
+ (Parent : Node_Id := Empty;
+ Decl : Node_Id := Empty)
+ is
begin
-- This loop runs more than once in the case where Check_End rejects
-- the END sequence, as indicated by Check_End returning False.
loop
- if Check_End then
+ if Check_End (Decl) then
if Present (Parent) then
Set_End_Label (Parent, End_Labl);
end if;
-- Evaluate End Entry --
------------------------
- procedure Evaluate_End_Entry (SS_Index : Int) is
+ procedure Evaluate_End_Entry (SS_Index : Nat) is
begin
Column_OK := (End_Column = Scope.Table (SS_Index).Ecol);
begin
if Nkind (End_Labl) in N_Has_Chars
+ and then Comes_From_Source (Nam)
and then Nkind (Nam) in N_Has_Chars
and then Chars (End_Labl) > Error_Name
and then Chars (Nam) > Error_Name
then
- Get_Name_String (Chars (End_Labl));
Error_Msg_Name_1 := Chars (Nam);
if Error_Msg_Name_1 > Error_Name then
- declare
- S : String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
-
- begin
- Get_Name_String (Error_Msg_Name_1);
-
- if Is_Bad_Spelling_Of
- (Name_Buffer (1 .. Name_Len), S)
- then
- Error_Msg_N ("misspelling of %", End_Labl);
- Syntax_OK := True;
- return;
- end if;
- end;
+ if Is_Bad_Spelling_Of (Chars (Nam), Chars (End_Labl)) then
+ Error_Msg_Name_1 := Chars (Nam);
+ Error_Msg_N -- CODEFIX
+ ("misspelling of %", End_Labl);
+ Syntax_OK := True;
+ return;
+ end if;
end if;
end if;
end;
-- case, this is acceptable only if the loop is unlabeled.
elsif End_Type = E_Loop then
- Syntax_OK := (Scope.Table (SS_Index).Labl = Empty);
+ Syntax_OK := not Explicit_Start_Label (SS_Index);
-- Cases where a label is definitely allowed on the END line
elsif End_Type = E_Name then
- Syntax_OK := (Scope.Table (SS_Index).Labl = Empty or else
- not Scope.Table (SS_Index).Lreq);
+ Syntax_OK := (not Explicit_Start_Label (SS_Index))
+ or else
+ (not Scope.Table (SS_Index).Lreq);
-- Otherwise we have cases which don't allow labels anyway, so we
-- certainly accept an END which does not have a label.
end if;
end Evaluate_End_Entry;
+ --------------------------
+ -- Explicit_Start_Label --
+ --------------------------
+
+ function Explicit_Start_Label (SS_Index : Nat) return Boolean is
+ L : constant Node_Id := Scope.Table (SS_Index).Labl;
+ Etyp : constant SS_End_Type := Scope.Table (SS_Index).Etyp;
+
+ begin
+ if No (L) then
+ return False;
+
+ -- In the following test we protect the call to Comes_From_Source
+ -- against lines containing previously reported syntax errors.
+
+ elsif (Etyp = E_Loop
+ or else Etyp = E_Name
+ or else Etyp = E_Suspicious_Is
+ or else Etyp = E_Bad_Is)
+ and then Comes_From_Source (L)
+ then
+ return True;
+ else
+ return False;
+ end if;
+ end Explicit_Start_Label;
+
------------------------
-- Output End Deleted --
------------------------
elsif End_Type = E_Record then
Error_Msg_SC ("no RECORD for this `END RECORD`!");
+ elsif End_Type = E_Return then
+ Error_Msg_SC ("no RETURN for this `END RETURN`!");
+
elsif End_Type = E_Select then
Error_Msg_SC ("no SELECT for this `END SELECT`!");
End_Type := Scope.Table (Scope.Last).Etyp;
Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
- Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc;
+ if Explicit_Start_Label (Scope.Last) then
+ Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
+ else
+ Error_Msg_Node_1 := Empty;
+ end if;
+
-- Suppress message if error was posted on opening label
if Error_Msg_Node_1 > Empty_Or_Error
end if;
if End_Type = E_Case then
- Error_Msg_SC ("`END CASE;` expected@ for CASE#!");
+ Error_Msg_SC -- CODEFIX
+ ("`END CASE;` expected@ for CASE#!");
elsif End_Type = E_If then
- Error_Msg_SC ("`END IF;` expected@ for IF#!");
+ Error_Msg_SC -- CODEFIX
+ ("`END IF;` expected@ for IF#!");
elsif End_Type = E_Loop then
if Error_Msg_Node_1 = Empty then
- Error_Msg_SC
+ Error_Msg_SC -- CODEFIX
("`END LOOP;` expected@ for LOOP#!");
else
- Error_Msg_SC ("`END LOOP &;` expected@!");
+ Error_Msg_SC -- CODEFIX
+ ("`END LOOP &;` expected@!");
end if;
elsif End_Type = E_Record then
- Error_Msg_SC
+ Error_Msg_SC -- CODEFIX
("`END RECORD;` expected@ for RECORD#!");
+ elsif End_Type = E_Return then
+ Error_Msg_SC -- CODEFIX
+ ("`END RETURN;` expected@ for RETURN#!");
+
elsif End_Type = E_Select then
- Error_Msg_SC
+ Error_Msg_SC -- CODEFIX
("`END SELECT;` expected@ for SELECT#!");
-- All remaining cases are cases with a name (we do not treat
elsif End_Type = E_Name or else (not Ins) then
if Error_Msg_Node_1 = Empty then
- Error_Msg_SC ("`END;` expected@ for BEGIN#!");
+ Error_Msg_SC -- CODEFIX
+ ("`END;` expected@ for BEGIN#!");
else
- Error_Msg_SC ("`END &;` expected@!");
+ Error_Msg_SC -- CODEFIX
+ ("`END &;` expected@!");
end if;
-- The other possibility is a missing END for a subprogram with a
end if;
End_Type := Scope.Table (Scope.Last).Etyp;
- Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc;
+ if Explicit_Start_Label (Scope.Last) then
+ Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
+ else
+ Error_Msg_Node_1 := Empty;
+ end if;
+
if End_Type = E_Case then
Error_Msg_BC ("missing `END CASE;` for CASE#!");
Error_Msg_SC
("missing `END RECORD;` for RECORD#!");
+ elsif End_Type = E_Return then
+ Error_Msg_SC
+ ("missing `END RETURN;` for RETURN#!");
+
elsif End_Type = E_Select then
Error_Msg_BC
("missing `END SELECT;` for SELECT#!");
else
-- A special check. If we have END; followed by an end of file,
-- WITH or SEPARATE, then if we are not at the outer level, then
- -- we have a sytax error. Consider the example:
+ -- we have a syntax error. Consider the example:
-- ...
-- declare
-- Right in this context means exactly right, or on the same
-- line as the opener.
- if Style.RM_Column_Check then
+ if RM_Column_Check then
if End_Column /= Scope.Table (Scope.Last).Ecol
and then Current_Line_Start > Scope.Table (Scope.Last).Sloc
+
+ -- A special case, for END RECORD, we are also allowed to
+ -- line up with the TYPE keyword opening the declaration.
+
+ and then (Scope.Table (Scope.Last).Etyp /= E_Record
+ or else Get_Column_Number (End_Sloc) /=
+ Get_Column_Number (Type_Token_Location))
then
Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
Error_Msg
and then
(Scope.Last = 1
or else
- (No (Scope.Table (Scope.Last - 1).Labl)
- or else
- not Same_Label
+ (not Explicit_Start_Label (Scope.Last - 1))
+ or else
+ (not Same_Label
(End_Labl,
Scope.Table (Scope.Last - 1).Labl)))
then
-- First we see how good the current END entry is with respect to
-- what we expect. It is considered pretty good if the token is OK,
- -- and either the label or the column matches. an END for RECORD is
+ -- and either the label or the column matches. An END for RECORD is
-- always considered to be pretty good in the record case. This is
-- because not only does a record disallow a nested structure, but
-- also it is unlikely that such nesting could occur by accident.
OSDN Git Service
