sem_util.ads, [...] (In_Pragma_Expression): New function.

2014-01-29  Robert Dewar  <dewar@adacore.com>

	* sem_util.ads, sem_util.adb (In_Pragma_Expression): New function.
	* sem_warn.adb (Check_References): Suppress warnings if inside
	Initial_Condition pragma.

From-SVN: r207266

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0f31179..fec258c 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2014-01-29  Robert Dewar  <dewar@adacore.com>
+
+       * sem_util.ads, sem_util.adb (In_Pragma_Expression): New function.
+       * sem_warn.adb (Check_References): Suppress warnings if inside
+       Initial_Condition pragma.
+
 2014-01-29  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * sem_prag.adb (Check_Missing_Part_Of): List all values of

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index e6b3233..58a28bb 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8447,6 +8447,25 @@ package body Sem_Util is
       return False;
    end In_Parameter_Specification;
 
+   --------------------------
+   -- In_Pragma_Expression --
+   --------------------------
+
+   function In_Pragma_Expression (N : Node_Id; Nam : Name_Id) return Boolean is
+      P : Node_Id;
+   begin
+      P := Parent (N);
+      loop
+         if No (P) then
+            return False;
+         elsif Nkind (P) = N_Pragma and then Pragma_Name (P) = Nam then
+            return True;
+         else
+            P := Parent (P);
+         end if;
+      end loop;
+   end In_Pragma_Expression;
+
    -------------------------------------
    -- In_Reverse_Storage_Order_Object --
    -------------------------------------

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 2fe44fc..5d32cfa 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1006,15 +1006,18 @@ package Sem_Util is
    function In_Parameter_Specification (N : Node_Id) return Boolean;
    --  Returns True if node N belongs to a parameter specification
 
+   function In_Pragma_Expression (N : Node_Id; Nam : Name_Id) return Boolean;
+   --  Returns true if the expression N occurs within a pragma with name Nam
+
    function In_Reverse_Storage_Order_Object (N : Node_Id) return Boolean;
    --  Returns True if N denotes a component or subcomponent in a record or
    --  array that has Reverse_Storage_Order.
 
    function In_Subprogram_Or_Concurrent_Unit return Boolean;
    --  Determines if the current scope is within a subprogram compilation unit
-   --  (inside a subprogram declaration, subprogram body, or generic
-   --  subprogram declaration) or within a task or protected body. The test is
-   --  for appearing anywhere within such a construct (that is it does not need
+   --  (inside a subprogram declaration, subprogram body, or generic subprogram
+   --  declaration) or within a task or protected body. The test is for
+   --  appearing anywhere within such a construct (that is it does not need
    --  to be directly within).
 
    function In_Visible_Part (Scope_Id : Entity_Id) return Boolean;

diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 62423ea..3c12676 100644 (file)
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -1315,6 +1315,14 @@ package body Sem_Warn is
                      UR := Expression (UR);
                   end loop;
 
+                  --  Don't issue warning if appearing inside Initial_Condition
+                  --  pragma or aspect, since that expression is not evaluated
+                  --  at the point where it occurs in the source.
+
+                  if In_Pragma_Expression (UR, Name_Initial_Condition) then
+                     goto Continue;
+                  end if;
+
                   --  Here we issue the warning, all checks completed
 
                   --  If we have a return statement, this was a case of an OUT
@@ -1380,7 +1388,6 @@ package body Sem_Warn is
                               end if;
                            end if;
                         end if;
-
                         --  All other cases of unset reference active
 
                      elsif not Warnings_Off_E1 then