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

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8fa3e22a0381068abaa97525ce870412b1603bd1..17fa34a2e4b9e479b28fb14693340c30787347a8 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index d7b588352c1db9a1b7d646d96e95627a0282a4c0..b9526747a863bd75ae605fc348ed71ecc01fe43c 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -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

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 476802ebb2bab0e36adbeb1811d805fe5c35c710..90cd1ca3621c12484b63f88bd1236591af86089f 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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.
 

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index d05c42b9bcaa68a847ccc03aa503a8f1127024d7..6fba6227ac5c68e82907d106ea02515636b216a6 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -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.