From: Hristian Kirtchev <kirtchev@adacore.com>
Date: Fri, 23 Oct 2015 12:19:35 +0000 (+0000)
Subject: sem_prag.adb (Analyze_Pragma): Pragma Volatile_Function should not apply to a functio... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=576da1ea413f42fceb2294db6bc38ab38f952e1b;p=gcc.git

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
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8fa3e22a038..17fa34a2e4b 100644
--- 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 d7b588352c1..b9526747a86 100644
--- 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 476802ebb2b..90cd1ca3621 100644
--- 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 d05c42b9bca..6fba6227ac5 100644
--- 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.