Commit 77237288 by Arnaud Charlet

[multiple changes]

2015-10-26  Bob Duff  <duff@adacore.com>

	* sem_ch13.adb (Check_Iterator_Functions): For a Default_Iterator
	aspect, make sure an implicitly declared interpretation is
	overridden by an explicit one.
	* sem_util.ads: Update comment.

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

	* sem_ch7.adb, sem_ch6.adb (Analyze_Subprogram_Body_Helper): Only source
	bodies should "freeze" the contract of the nearest enclosing
	package body.

From-SVN: r229321
parent 02886c2e
2015-10-26 Bob Duff <duff@adacore.com>
* sem_ch13.adb (Check_Iterator_Functions): For a Default_Iterator
aspect, make sure an implicitly declared interpretation is
overridden by an explicit one.
* sem_util.ads: Update comment.
2015-10-26 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch7.adb, sem_ch6.adb (Analyze_Subprogram_Body_Helper): Only source
bodies should "freeze" the contract of the nearest enclosing
package body.
2015-10-26 Joel Brobecker <brobecker@adacore.com brobecker> 2015-10-26 Joel Brobecker <brobecker@adacore.com brobecker>
* adaint.c (__gnat_lwp_self): Replace current implementation re-using * adaint.c (__gnat_lwp_self): Replace current implementation re-using
......
...@@ -4277,8 +4277,8 @@ package body Sem_Ch13 is ...@@ -4277,8 +4277,8 @@ package body Sem_Ch13 is
else else
declare declare
Default : Entity_Id := Empty; Default : Entity_Id := Empty;
I : Interp_Index; I : Interp_Index;
It : Interp; It : Interp;
begin begin
Get_First_Interp (Expr, I, It); Get_First_Interp (Expr, I, It);
...@@ -4289,12 +4289,21 @@ package body Sem_Ch13 is ...@@ -4289,12 +4289,21 @@ package body Sem_Ch13 is
Remove_Interp (I); Remove_Interp (I);
elsif Present (Default) then elsif Present (Default) then
Error_Msg_N ("default iterator must be unique", Expr);
Error_Msg_Sloc := Sloc (Default);
Error_Msg_N ("\\possible interpretation#", Expr);
Error_Msg_Sloc := Sloc (It.Nam);
Error_Msg_N ("\\possible interpretation#", Expr);
-- An explicit one should override an implicit one
if Comes_From_Source (Default) =
Comes_From_Source (It.Nam)
then
Error_Msg_N ("default iterator must be unique", Expr);
Error_Msg_Sloc := Sloc (Default);
Error_Msg_N ("\\possible interpretation#", Expr);
Error_Msg_Sloc := Sloc (It.Nam);
Error_Msg_N ("\\possible interpretation#", Expr);
elsif Comes_From_Source (It.Nam) then
Default := It.Nam;
end if;
else else
Default := It.Nam; Default := It.Nam;
end if; end if;
......
...@@ -3011,7 +3011,14 @@ package body Sem_Ch6 is ...@@ -3011,7 +3011,14 @@ package body Sem_Ch6 is
-- decoupled from the usual Freeze_xxx mechanism because it must also -- decoupled from the usual Freeze_xxx mechanism because it must also
-- work in the context of generics where normal freezing is disabled. -- work in the context of generics where normal freezing is disabled.
Analyze_Enclosing_Package_Body_Contract (N); -- Only bodies coming from source should cause this type of "freezing".
-- Expression functions that act as bodies and complete an initial
-- declaration must be included in this category, hence the use of
-- Original_Node.
if Comes_From_Source (Original_Node (N)) then
Analyze_Enclosing_Package_Body_Contract (N);
end if;
-- Generic subprograms are handled separately. They always have a -- Generic subprograms are handled separately. They always have a
-- generic specification. Determine whether current scope has a -- generic specification. Determine whether current scope has a
......
...@@ -564,7 +564,11 @@ package body Sem_Ch7 is ...@@ -564,7 +564,11 @@ package body Sem_Ch7 is
-- Freeze_xxx mechanism because it must also work in the context of -- Freeze_xxx mechanism because it must also work in the context of
-- generics where normal freezing is disabled. -- generics where normal freezing is disabled.
Analyze_Enclosing_Package_Body_Contract (N); -- Only bodies coming from source should cause this type of "freezing"
if Comes_From_Source (N) then
Analyze_Enclosing_Package_Body_Contract (N);
end if;
-- Find corresponding package specification, and establish the current -- Find corresponding package specification, and establish the current
-- scope. The visible defining entity for the package is the defining -- scope. The visible defining entity for the package is the defining
......
...@@ -538,10 +538,9 @@ package Sem_Util is ...@@ -538,10 +538,9 @@ package Sem_Util is
function Enclosing_Lib_Unit_Entity function Enclosing_Lib_Unit_Entity
(E : Entity_Id := Current_Scope) return Entity_Id; (E : Entity_Id := Current_Scope) return Entity_Id;
-- Returns the entity of enclosing library unit node which is the -- Returns the entity of enclosing library unit node which is the root of
-- root of the current scope (which must not be Standard_Standard, and the -- the current scope (which must not be Standard_Standard, and the caller
-- caller is responsible for ensuring this condition) or other specified -- is responsible for ensuring this condition) or other specified entity.
-- entity.
function Enclosing_Lib_Unit_Node (N : Node_Id) return Node_Id; function Enclosing_Lib_Unit_Node (N : Node_Id) return Node_Id;
-- Returns the N_Compilation_Unit node of the library unit that is directly -- Returns the N_Compilation_Unit node of the library unit that is directly
......
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