OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2010-10-12  Robert Dewar  <dewar@adacore.com>

	* par-endh.adb (Check_End): Don't swallow semicolon or aspects after
	END RECORD.
	* sem_attr.adb (Eval_Attribute): Code clean up.

2010-10-12  Robert Dewar  <dewar@adacore.com>

	* par-ch12.adb (P_Formal_Private_Type_Definition): Improve error
	messages and recovery for case of out of order Abstract/Tagged/Private
	keywords.
	* par-ch3.adb (P_Type_Declaration): Improve error messages and recovery
	for case of out of order Abstract/Tagged/Private keywords.

2010-10-12  Ed Schonberg  <schonberg@adacore.com>

	* inline.adb (Analyze_Inlined_Bodies): Restrict previous change to case
	where child unit is main unit of compilation.

From-SVN: r165354
This commit is contained in:
Arnaud Charlet 2010-10-12 11:42:31 +02:00
parent 718deaf1af
commit 92cbddaa2a
6 changed files with 120 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/ada/ChangeLog
View File

@ -1,3 +1,22 @@
2010-10-12 Robert Dewar <dewar@adacore.com>
* par-endh.adb (Check_End): Don't swallow semicolon or aspects after
END RECORD.
* sem_attr.adb (Eval_Attribute): Code clean up.
2010-10-12 Robert Dewar <dewar@adacore.com>
* par-ch12.adb (P_Formal_Private_Type_Definition): Improve error
messages and recovery for case of out of order Abstract/Tagged/Private
keywords.
* par-ch3.adb (P_Type_Declaration): Improve error messages and recovery
for case of out of order Abstract/Tagged/Private keywords.
2010-10-12 Ed Schonberg <schonberg@adacore.com>
* inline.adb (Analyze_Inlined_Bodies): Restrict previous change to case
where child unit is main unit of compilation.
2010-10-12 Robert Dewar <dewar@adacore.com>
* aspects.ads, aspects.adb (Move_Aspects): New procedure.

25
gcc/ada/inline.adb
View File

@ -626,19 +626,19 @@ package body Inline is
Pack : Entity_Id;
S : Succ_Index;
function Is_Ancestor
function Is_Ancestor_Of_Main
(U_Name : Entity_Id;
Nam : Node_Id) return Boolean;
-- Determine whether the unit whose body is loaded is an ancestor of
-- a unit mentioned in a with_clause of that body. The body is not
-- the main unit, and has a with_clause on it. The body is not
-- analyzed yet, so the check is purely lexical: the name of the with
-- clause is a selected component, and names of ancestors must match.
-----------------
-- Is_Ancestor --
-----------------
-------------------------
-- Is_Ancestor_Of_Main --
-------------------------
function Is_Ancestor
function Is_Ancestor_Of_Main
(U_Name : Entity_Id;
Nam : Node_Id) return Boolean
is
@ -649,6 +649,12 @@ package body Inline is
return False;
else
if Chars (Selector_Name (Nam)) /=
Chars (Cunit_Entity (Main_Unit))
then
return False;
end if;
Pref := Prefix (Nam);
if Nkind (Pref) = N_Identifier then
@ -666,10 +672,10 @@ package body Inline is
else
-- A is an ancestor of A.B.C if it is an ancestor of A.B
return Is_Ancestor (U_Name, Pref);
return Is_Ancestor_Of_Main (U_Name, Pref);
end if;
end if;
end Is_Ancestor;
end Is_Ancestor_Of_Main;
-- Start of processing for Analyze_Inlined_Bodies
@ -751,7 +757,8 @@ package body Inline is
Item := First (Context_Items (Body_Unit));
while Present (Item) loop
if Nkind (Item) = N_With_Clause
and then Is_Ancestor (U_Id, Name (Item))
and then
Is_Ancestor_Of_Main (U_Id, Name (Item))
then
Set_Is_Inlined (U_Id, False);
exit;

14
gcc/ada/par-ch12.adb
View File

@ -834,6 +834,20 @@ package body Ch12 is
Set_Sloc (Def_Node, Token_Ptr);
T_Private;
if Token = Tok_Tagged then -- CODEFIX
Error_Msg_SC ("TAGGED must come before PRIVATE");
Scan; -- past TAGGED
elsif Token = Tok_Abstract then -- CODEFIX
Error_Msg_SC ("`ABSTRACT TAGGED` must come before PRIVATE");
Scan; -- past ABSTRACT
if Token = Tok_Tagged then
Scan; -- past TAGGED
end if;
end if;
return Def_Node;
end P_Formal_Private_Type_Definition;

26
gcc/ada/par-ch3.adb
View File

@ -309,11 +309,11 @@ package body Ch3 is
-- Error recovery: can raise Error_Resync
-- Note: The processing for full type declaration, incomplete type
-- declaration, private type declaration and type definition is
-- included in this function. The processing for concurrent type
-- declarations is NOT here, but rather in chapter 9 (i.e. this
-- function handles only declarations starting with TYPE).
-- The processing for full type declarations, incomplete type declarations,
-- private type declarations and type definitions is included in this
-- function. The processing for concurrent type declarations is NOT here,
-- but rather in chapter 9 (this function handles only declarations
-- starting with TYPE).
function P_Type_Declaration return Node_Id is
Abstract_Present : Boolean := False;
@ -770,6 +770,22 @@ package body Ch3 is
when Tok_Private =>
Decl_Node := New_Node (N_Private_Type_Declaration, Type_Loc);
Scan; -- past PRIVATE
-- Check error cases of private [abstract] tagged
if Token = Tok_Abstract then
Error_Msg_SC ("`ABSTRACT TAGGED` must come before PRIVATE");
Scan; -- past ABSTRACT
if Token = Tok_Tagged then
Scan; -- past TAGGED
end if;
elsif Token = Tok_Tagged then
Error_Msg_SC ("TAGGED must come before PRIVATE");
Scan; -- past TAGGED
end if;
exit;
-- Ada 2005 (AI-345): Protected, synchronized or task interface

71
gcc/ada/par-endh.adb
View File

@ -387,48 +387,51 @@ package body Endh is
end if;
end if;
-- Scan aspect specifications if permitted here
-- 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 Aspect_Specifications_Present then
if No (Decl) then
P_Aspect_Specifications (Error);
else
P_Aspect_Specifications (Decl);
end if;
if End_Type /= E_Record then
-- 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!)
-- Scan aspect specifications if permitted here
elsif End_Type /= E_Record then
if Token = Tok_Semicolon then
T_Semicolon;
if Aspect_Specifications_Present then
if No (Decl) then
P_Aspect_Specifications (Error);
else
P_Aspect_Specifications (Decl);
end if;
-- 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).
-- If no aspect specifications, must have a semicolon
-- 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 End_Type /= E_Record then
if Token = Tok_Semicolon then
T_Semicolon;
elsif Token_Is_At_Start_Of_Line
or else Token = Tok_Colon
or else Token = Tok_Dot
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).
-- 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.
-- 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.
else
End_OK := False;
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;

39
gcc/ada/sem_attr.adb
View File

@ -5375,33 +5375,20 @@ package body Sem_Attr is
-- constructs from this test comes from some internal usage in packed
-- arrays, which otherwise fails, could use more analysis perhaps???
declare
function Within_Aspect (N : Node_Id) return Boolean;
-- True if within aspect expression. Giant kludge, do this test only
-- within an aspect, since doing it more widely, even though clearly
-- correct, causes regressions notably in GA19-001 ???
-- We do however go ahead with generic actual types, otherwise we get
-- some regressions, probably these types should be frozen anyway???
function Within_Aspect (N : Node_Id) return Boolean
is
begin
if No (Parent (N)) then
return False;
elsif Nkind (N) = N_Aspect_Specification then
return True;
else
return Within_Aspect (Parent (N));
end if;
end Within_Aspect;
begin
if In_Spec_Expression
and then Comes_From_Source (N)
and then not (Is_Entity_Name (P) and then Is_Frozen (Entity (P)))
and then Within_Aspect (N)
then
return;
end if;
end;
if In_Spec_Expression
and then Comes_From_Source (N)
and then not (Is_Entity_Name (P)
and then
(Is_Frozen (Entity (P))
or else (Is_Type (Entity (P))
and then
Is_Generic_Actual_Type (Entity (P)))))
then
return;
end if;
-- Acquire first two expressions (at the moment, no attributes take more
-- than two expressions in any case).