sem_prag.adb (Analyze_Pragma): Pragma Volatile_Function should not apply to a function instantiation.

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

	* sem_prag.adb (Analyze_Pragma): Pragma Volatile_Function should
	not apply to a function instantiation.
	* sem_util.adb (Has_Effectively_Volatile_Profile): New routine.
	(Is_Volatile_Function): An instance of Ada.Unchecked_Conversion
	is a volatile function when its profile contains an effectively
	volatile type.
	* sem_util.ads (Has_Effectively_Volatile_Profile): New routine.

From-SVN: r229238
This commit is contained in:
Hristian Kirtchev 2015-10-23 12:19:35 +00:00 committed by Arnaud Charlet
parent 3e5bb7eece
commit 576da1ea41
4 changed files with 60 additions and 10 deletions

View File

@ -1,3 +1,13 @@
2015-10-23 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Pragma): Pragma Volatile_Function should
not apply to a function instantiation.
* sem_util.adb (Has_Effectively_Volatile_Profile): New routine.
(Is_Volatile_Function): An instance of Ada.Unchecked_Conversion
is a volatile function when its profile contains an effectively
volatile type.
* sem_util.ads (Has_Effectively_Volatile_Profile): New routine.
2015-10-23 Arnaud Charlet <charlet@adacore.com>
* exp_unst.adb (Unnest_Subprogram): Complete previous

View File

@ -21543,14 +21543,9 @@ package body Sem_Prag is
Subp_Decl :=
Find_Related_Subprogram_Or_Body (N, Do_Checks => True);
-- Function instantiation
if Nkind (Subp_Decl) = N_Function_Instantiation then
null;
-- Generic subprogram
elsif Nkind (Subp_Decl) = N_Generic_Subprogram_Declaration then
if Nkind (Subp_Decl) = N_Generic_Subprogram_Declaration then
null;
-- Body acts as spec
@ -21578,7 +21573,6 @@ package body Sem_Prag is
end if;
Spec_Id := Corresponding_Spec_Of (Subp_Decl);
Over_Id := Overridden_Operation (Spec_Id);
if not Ekind_In (Spec_Id, E_Function, E_Generic_Function) then
Pragma_Misplaced;
@ -21595,6 +21589,8 @@ package body Sem_Prag is
-- in New_Overloaded_Entity, however at that point the pragma has
-- not been processed yet.
Over_Id := Overridden_Operation (Spec_Id);
if Present (Over_Id)
and then not Is_Volatile_Function (Over_Id)
then

View File

@ -2108,9 +2108,7 @@ package body Sem_Util is
T := Full_View (T);
end if;
if Is_Descendent_Of_Address (T)
or else Is_Limited_Type (T)
then
if Is_Descendent_Of_Address (T) or else Is_Limited_Type (T) then
Set_Is_Pure (Subp_Id, False);
exit;
end if;
@ -8552,6 +8550,39 @@ package body Sem_Util is
return False;
end Has_Discriminant_Dependent_Constraint;
--------------------------------------
-- Has_Effectively_Volatile_Profile --
--------------------------------------
function Has_Effectively_Volatile_Profile
(Subp_Id : Entity_Id) return Boolean
is
Formal : Entity_Id;
begin
-- Inspect the formal parameters looking for an effectively volatile
-- type.
Formal := First_Formal (Subp_Id);
while Present (Formal) loop
if Is_Effectively_Volatile (Etype (Formal)) then
return True;
end if;
Next_Formal (Formal);
end loop;
-- Inspect the return type of functions
if Ekind_In (Subp_Id, E_Function, E_Generic_Function)
and then Is_Effectively_Volatile (Etype (Subp_Id))
then
return True;
end if;
return False;
end Has_Effectively_Volatile_Profile;
--------------------------
-- Has_Enabled_Property --
--------------------------
@ -13721,6 +13752,14 @@ package body Sem_Util is
then
return True;
-- An instance of Ada.Unchecked_Conversion is a volatile function if
-- either the source or the target are effectively volatile.
elsif Is_Unchecked_Conversion_Instance (Func_Id)
and then Has_Effectively_Volatile_Profile (Func_Id)
then
return True;
-- Otherwise the function is treated as volatile if it is subject to
-- enabled pragma Volatile_Function.

View File

@ -1006,6 +1006,11 @@ package Sem_Util is
-- Returns True if and only if Comp has a constrained subtype that depends
-- on a discriminant.
function Has_Effectively_Volatile_Profile
(Subp_Id : Entity_Id) return Boolean;
-- Determine whether subprogram Subp_Id has an effectively volatile formal
-- parameter or returns an effectively volatile value.
function Has_Infinities (E : Entity_Id) return Boolean;
-- Determines if the range of the floating-point type E includes
-- infinities. Returns False if E is not a floating-point type.