From: Robert Dewar Date: Fri, 10 Apr 2009 09:58:35 +0000 (+0000) Subject: sem_aux.ads, [...] (Nearest_Current_Scope): New function. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=24357840f1d9fbeb5f604b33b541479786d9910a;p=gcc.git sem_aux.ads, [...] (Nearest_Current_Scope): New function. 2009-04-10 Robert Dewar * 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 c8a1785e3b0..4aced676bd3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2009-04-10 Robert Dewar + + * 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 * make.adb: Add comment. diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 4acfb1d48bd..94db312c2e1 100755 --- 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 53bad53faee..f8467446130 100755 --- 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 9ff9d80766e..a6c5aad9e59 100644 --- 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))))