Commit ed962eda by Arnaud Charlet

[multiple changes]

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

	* sem_util.adb (Is_Suspension_Object): Ensure that the scope of "Ada"
	is Standard_Standard.

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

	* sem_res.adb (Is_OK_Volatile_Context): A subprogram call is an OK
	context for a reference to an effectively volatile object.
	(Resolve_Actuals): Add references to SPARK RM.
	(Within_Procedure_Call): Removed.
	(Within_Subprogram_Call): New routine.

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

	* sem_ch6.adb (Check_Aggregate_Accessibility): A reference to a
	formal parameter in an aggregate does not need an accesibility
	check only if the formal is aliased.

From-SVN: r229329
parent 877a5a12
2015-10-26 Hristian Kirtchev <kirtchev@adacore.com>
* sem_util.adb (Is_Suspension_Object): Ensure that the scope of "Ada"
is Standard_Standard.
2015-10-26 Hristian Kirtchev <kirtchev@adacore.com>
* sem_res.adb (Is_OK_Volatile_Context): A subprogram call is an OK
context for a reference to an effectively volatile object.
(Resolve_Actuals): Add references to SPARK RM.
(Within_Procedure_Call): Removed.
(Within_Subprogram_Call): New routine.
2015-10-26 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Check_Aggregate_Accessibility): A reference to a
formal parameter in an aggregate does not need an accesibility
check only if the formal is aliased.
2015-10-26 Claire Dross <dross@adacore.com> 2015-10-26 Claire Dross <dross@adacore.com>
* sem_aux.ads (Number_Components): Can return 0 when called on * sem_aux.ads (Number_Components): Can return 0 when called on
......
...@@ -661,10 +661,13 @@ package body Sem_Ch6 is ...@@ -661,10 +661,13 @@ package body Sem_Ch6 is
Obj := Prefix (Obj); Obj := Prefix (Obj);
end loop; end loop;
-- No check needed for an aliased formal.
-- A run-time check may still be needed ???
if Is_Entity_Name (Obj) if Is_Entity_Name (Obj)
and then Is_Formal (Entity (Obj)) and then Is_Formal (Entity (Obj))
and then Is_Aliased (Entity (Obj))
then then
-- A run-time check may be needed ???
null; null;
elsif Object_Access_Level (Obj) > elsif Object_Access_Level (Obj) >
......
...@@ -4464,17 +4464,18 @@ package body Sem_Res is ...@@ -4464,17 +4464,18 @@ package body Sem_Res is
and then Comes_From_Source (A) and then Comes_From_Source (A)
and then Is_Effectively_Volatile_Object (A) and then Is_Effectively_Volatile_Object (A)
then then
-- An effectively volatile object may act as an actual -- An effectively volatile object may act as an actual when the
-- parameter when the corresponding formal is of a non-scalar -- corresponding formal is of a non-scalar volatile type
-- volatile type. -- (SPARK RM 7.1.3(12)).
if Is_Volatile (Etype (F)) if Is_Volatile (Etype (F))
and then not Is_Scalar_Type (Etype (F)) and then not Is_Scalar_Type (Etype (F))
then then
null; null;
-- An effectively volatile object may act as an actual -- An effectively volatile object may act as an actual in a
-- parameter in a call to an instance of Unchecked_Conversion. -- call to an instance of Unchecked_Conversion.
-- (SPARK RM 7.1.3(12)).
elsif Is_Unchecked_Conversion_Instance (Nam) then elsif Is_Unchecked_Conversion_Instance (Nam) then
null; null;
...@@ -6843,7 +6844,7 @@ package body Sem_Res is ...@@ -6843,7 +6844,7 @@ package body Sem_Res is
function Within_Check (Nod : Node_Id) return Boolean; function Within_Check (Nod : Node_Id) return Boolean;
-- Determine whether an arbitrary node appears in a check node -- Determine whether an arbitrary node appears in a check node
function Within_Procedure_Call (Nod : Node_Id) return Boolean; function Within_Subprogram_Call (Nod : Node_Id) return Boolean;
-- Determine whether an arbitrary node appears in a procedure call -- Determine whether an arbitrary node appears in a procedure call
function Within_Volatile_Function (Id : Entity_Id) return Boolean; function Within_Volatile_Function (Id : Entity_Id) return Boolean;
...@@ -6907,19 +6908,21 @@ package body Sem_Res is ...@@ -6907,19 +6908,21 @@ package body Sem_Res is
return False; return False;
end Within_Check; end Within_Check;
--------------------------- ----------------------------
-- Within_Procedure_Call -- -- Within_Subprogram_Call --
--------------------------- ----------------------------
function Within_Procedure_Call (Nod : Node_Id) return Boolean is function Within_Subprogram_Call (Nod : Node_Id) return Boolean is
Par : Node_Id; Par : Node_Id;
begin begin
-- Climb the parent chain looking for a procedure call -- Climb the parent chain looking for a function or procedure call
Par := Nod; Par := Nod;
while Present (Par) loop while Present (Par) loop
if Nkind (Par) = N_Procedure_Call_Statement then if Nkind_In (Par, N_Function_Call,
N_Procedure_Call_Statement)
then
return True; return True;
-- Prevent the search from going too far -- Prevent the search from going too far
...@@ -6932,7 +6935,7 @@ package body Sem_Res is ...@@ -6932,7 +6935,7 @@ package body Sem_Res is
end loop; end loop;
return False; return False;
end Within_Procedure_Call; end Within_Subprogram_Call;
------------------------------ ------------------------------
-- Within_Volatile_Function -- -- Within_Volatile_Function --
...@@ -7049,10 +7052,10 @@ package body Sem_Res is ...@@ -7049,10 +7052,10 @@ package body Sem_Res is
return True; return True;
-- Assume that references to effectively volatile objects that appear -- Assume that references to effectively volatile objects that appear
-- as actual parameters in a procedure call are always legal. A full -- as actual parameters in a subprogram call are always legal. A full
-- legality check is done when the actuals are resolved. -- legality check is done when the actuals are resolved.
elsif Within_Procedure_Call (Context) then elsif Within_Subprogram_Call (Context) then
return True; return True;
-- Otherwise the context is not suitable for an effectively volatile -- Otherwise the context is not suitable for an effectively volatile
......
...@@ -11331,7 +11331,9 @@ package body Sem_Util is ...@@ -11331,7 +11331,9 @@ package body Sem_Util is
and then Present (Scope (Id)) and then Present (Scope (Id))
and then Chars (Scope (Id)) = Name_Synchronous_Task_Control and then Chars (Scope (Id)) = Name_Synchronous_Task_Control
and then Present (Scope (Scope (Id))) and then Present (Scope (Scope (Id)))
and then Chars (Scope (Scope (Id))) = Name_Ada; and then Chars (Scope (Scope (Id))) = Name_Ada
and then Present (Scope (Scope (Scope (Id))))
and then Scope (Scope (Scope (Id))) = Standard_Standard;
end Is_Suspension_Object; end Is_Suspension_Object;
-- Local variables -- Local variables
......
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