Commit 335dde29 by Arnaud Charlet

[multiple changes]

2015-10-26  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch9.adb (Analyze_Single_Protected_Declaration): The anonymous
	object no longer comes from source.
	(Analyze_Single_Task_Declaration): The anonymous object no longer
	comes from source.
	* sem_prag.adb (Analyze_Pragma): The analysis of pragma SPARK_Mode
	now recognizes the internal anonymous object created for a single
	concurren type as a valid context.
	(Find_Related_Context): The internal anonymous object created for a
	single concurrent type is now a valid context.
	(Find_Related_Declaration_Or_Body): The internal anonymous object
	created for a single concurrent type is now a valid context.

2015-10-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Inherit_Rep_Item_Chain): Another another guard
	to prevent circularities in the rep_item_chain of the full view
	of a type extension in a child unit that extends a private type
	from the parent.

From-SVN: r229374
parent 378dc6ca
2015-10-26 Hristian Kirtchev <kirtchev@adacore.com> 2015-10-26 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch9.adb (Analyze_Single_Protected_Declaration): The anonymous
object no longer comes from source.
(Analyze_Single_Task_Declaration): The anonymous object no longer
comes from source.
* sem_prag.adb (Analyze_Pragma): The analysis of pragma SPARK_Mode
now recognizes the internal anonymous object created for a single
concurren type as a valid context.
(Find_Related_Context): The internal anonymous object created for a
single concurrent type is now a valid context.
(Find_Related_Declaration_Or_Body): The internal anonymous object
created for a single concurrent type is now a valid context.
2015-10-26 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (Inherit_Rep_Item_Chain): Another another guard
to prevent circularities in the rep_item_chain of the full view
of a type extension in a child unit that extends a private type
from the parent.
2015-10-26 Hristian Kirtchev <kirtchev@adacore.com>
* atree.ads, atree.adb (Ekind_In): New 10 and 11 parameter versions. * atree.ads, atree.adb (Ekind_In): New 10 and 11 parameter versions.
* contracts.ads, contracts.adb (Analyze_Initial_Declaration_Contract): * contracts.ads, contracts.adb (Analyze_Initial_Declaration_Contract):
New routine. New routine.
......
...@@ -2665,11 +2665,6 @@ package body Sem_Ch9 is ...@@ -2665,11 +2665,6 @@ package body Sem_Ch9 is
Defining_Identifier => Obj_Id, Defining_Identifier => Obj_Id,
Object_Definition => New_Occurrence_Of (Typ, Loc)); Object_Definition => New_Occurrence_Of (Typ, Loc));
-- Relocate the aspects that appear on the original single protected
-- declaration to the object as the object is the visible name.
Set_Comes_From_Source (Obj_Decl, True);
Insert_After (N, Obj_Decl); Insert_After (N, Obj_Decl);
Mark_Rewrite_Insertion (Obj_Decl); Mark_Rewrite_Insertion (Obj_Decl);
...@@ -2756,11 +2751,6 @@ package body Sem_Ch9 is ...@@ -2756,11 +2751,6 @@ package body Sem_Ch9 is
Defining_Identifier => Obj_Id, Defining_Identifier => Obj_Id,
Object_Definition => New_Occurrence_Of (Typ, Loc)); Object_Definition => New_Occurrence_Of (Typ, Loc));
-- Relocate the aspects that appear on the original single protected
-- declaration to the object as the object is the visible name.
Set_Comes_From_Source (Obj_Decl, True);
Insert_After (N, Obj_Decl); Insert_After (N, Obj_Decl);
Mark_Rewrite_Insertion (Obj_Decl); Mark_Rewrite_Insertion (Obj_Decl);
......
...@@ -20543,6 +20543,20 @@ package body Sem_Prag is ...@@ -20543,6 +20543,20 @@ package body Sem_Prag is
Process_Overloadable (Stmt); Process_Overloadable (Stmt);
return; return;
-- The pragma applies to the anonymous object created for a
-- single concurrent type.
-- protected type Anon_Prot_Typ ...;
-- Obj : Anon_Prot_Typ;
-- pragma SPARK_Mode ...;
elsif Nkind (Stmt) = N_Object_Declaration
and then Is_Single_Concurrent_Object
(Defining_Entity (Stmt))
then
Process_Overloadable (Stmt);
return;
-- Skip internally generated code -- Skip internally generated code
elsif not Comes_From_Source (Stmt) then elsif not Comes_From_Source (Stmt) then
...@@ -20567,20 +20581,6 @@ package body Sem_Prag is ...@@ -20567,20 +20581,6 @@ package body Sem_Prag is
Process_Overloadable (Stmt); Process_Overloadable (Stmt);
return; return;
-- The pragma applies to the anonymous object created for a
-- single concurrent type.
-- protected type Anon_Prot_Typ ...;
-- Obj : Anon_Prot_Typ;
-- pragma SPARK_Mode ...;
elsif Nkind (Stmt) = N_Object_Declaration
and then Is_Single_Concurrent_Object
(Defining_Entity (Stmt))
then
Process_Overloadable (Stmt);
return;
-- Otherwise the pragma does not apply to a legal construct -- Otherwise the pragma does not apply to a legal construct
-- or it does not appear at the top of a declarative or a -- or it does not appear at the top of a declarative or a
-- statement list. Issue an error and stop the analysis. -- statement list. Issue an error and stop the analysis.
...@@ -26697,7 +26697,15 @@ package body Sem_Prag is ...@@ -26697,7 +26697,15 @@ package body Sem_Prag is
-- Skip internally generated code -- Skip internally generated code
elsif not Comes_From_Source (Stmt) then elsif not Comes_From_Source (Stmt) then
null;
-- The anonymous object created for a single concurrent type is a
-- suitable context.
if Nkind (Stmt) = N_Object_Declaration
and then Is_Single_Concurrent_Object (Defining_Entity (Stmt))
then
return Stmt;
end if;
-- Return the current source construct -- Return the current source construct
...@@ -26800,7 +26808,16 @@ package body Sem_Prag is ...@@ -26800,7 +26808,16 @@ package body Sem_Prag is
-- Skip internally generated code -- Skip internally generated code
elsif not Comes_From_Source (Stmt) then elsif not Comes_From_Source (Stmt) then
if Nkind (Stmt) = N_Subprogram_Declaration then
-- The anonymous object created for a single concurrent type is a
-- suitable context.
if Nkind (Stmt) = N_Object_Declaration
and then Is_Single_Concurrent_Object (Defining_Entity (Stmt))
then
return Stmt;
elsif Nkind (Stmt) = N_Subprogram_Declaration then
-- The subprogram declaration is an internally generated spec -- The subprogram declaration is an internally generated spec
-- for an expression function. -- for an expression function.
......
...@@ -10320,6 +10320,25 @@ package body Sem_Util is ...@@ -10320,6 +10320,25 @@ package body Sem_Util is
Item := Next_Rep_Item (Item); Item := Next_Rep_Item (Item);
end loop; end loop;
Item := First_Rep_Item (From_Typ);
-- Additional check when both parent and current type have rep.
-- items, to prevent circularities when the derivation completes
-- a private declaration and inherits from both views of the parent.
-- There may be a remaining problem with the proper ordering of
-- attribute specifications and aspects on the chains of the four
-- entities involved. ???
if Present (Item) and then Present (From_Item) then
while Present (Item) loop
if Item = First_Rep_Item (Typ) then
return;
end if;
Item := Next_Rep_Item (Item);
end loop;
end if;
-- When the destination type has a rep item chain, the chain of the -- When the destination type has a rep item chain, the chain of the
-- source type is appended to it. -- source type is appended to it.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment