sem_aux.ads, [...] (Nearest_Current_Scope): New function.

2009-04-10  Robert Dewar  <dewar@adacore.com>

	* sem_aux.ads, sem_aux.adb (Nearest_Current_Scope): New function.

	* sem_res.adb (Resolve_Call): Fix test for
	Suppress_Value_Tracking_On_Call (was wrong for the case of a call from
	a non-dynamic scope).

From-SVN: r145881

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c8a1785e3b0d4d3e2f8aab05530881cb17e1b112..4aced676bd3417987a2d9d7f5f9a4e68fb257263 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2009-04-10  Robert Dewar  <dewar@adacore.com>
+
+       * sem_aux.ads, sem_aux.adb (Nearest_Current_Scope): New function.
+
+       * sem_res.adb (Resolve_Call): Fix test for
+       Suppress_Value_Tracking_On_Call (was wrong for the case of a call from
+       a non-dynamic scope).
+
 2009-04-10  Robert Dewar  <dewar@adacore.com>
 
        * make.adb: Add comment.

diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 4acfb1d48bd4ebc74d29ea9790b166477e181f2f..94db312c2e1e9f3d9707d79d42ed0fad4c88ec25 100755 (executable)
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -158,7 +158,7 @@ package body Sem_Aux is
    -----------------------------
 
    function Enclosing_Dynamic_Scope (Ent : Entity_Id) return Entity_Id is
-      S  : Entity_Id;
+      S : Entity_Id;
 
    begin
       --  The following test is an error defense against some syntax
@@ -710,6 +710,19 @@ package body Sem_Aux is
       end if;
    end Is_Limited_Type;
 
+   ---------------------------
+   -- Nearest_Dynamic_Scope --
+   ---------------------------
+
+   function Nearest_Dynamic_Scope (Ent : Entity_Id) return Entity_Id is
+   begin
+      if Is_Dynamic_Scope (Ent) then
+         return Ent;
+      else
+         return Enclosing_Dynamic_Scope (Ent);
+      end if;
+   end Nearest_Dynamic_Scope;
+
    ------------------------
    -- Next_Tag_Component --
    ------------------------

diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads
index 53bad53faee6b9baac95d1a27b736d36b4d69e31..f8467446130db723a34b6bd50a7610a882b3e782 100755 (executable)
--- a/gcc/ada/sem_aux.ads
+++ b/gcc/ada/sem_aux.ads
@@ -180,6 +180,11 @@ package Sem_Aux is
    --  composite containing a limited component, or a subtype of any of
    --  these types).
 
+   function Nearest_Dynamic_Scope (Ent : Entity_Id) return Entity_Id;
+   --  This is similar to Enclosing_Dynamic_Scope except that if Ent is itself
+   --  a dynamic scope, then it is returned. Otherwise the result is the same
+   --  as that returned by Enclosing_Dynamic_Scope.
+
    function Next_Tag_Component (Tag : Entity_Id) return Entity_Id;
    --  Tag must be an entity representing a _Tag field of a tagged record.
    --  The result returned is the next _Tag field in this record, or Empty

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 9ff9d80766e042226e7c1da899365661054b31ce..a6c5aad9e593ebdf2869480813ac0473380dfeda 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -5150,7 +5150,8 @@ package body Sem_Res is
 
       if Inside_Freezing_Actions = 0
         and then (not Is_Library_Level_Entity (Nam)
-                   or else Suppress_Value_Tracking_On_Call (Current_Scope))
+                   or else Suppress_Value_Tracking_On_Call
+                             (Nearest_Dynamic_Scope (Current_Scope)))
         and then (Comes_From_Source (Nam)
                    or else (Present (Alias (Nam))
                              and then Comes_From_Source (Alias (Nam))))