From 6f31a9d795f204b599466d53ef22cc579bfe37bd Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Wed, 26 Sep 2007 12:46:00 +0200 Subject: [PATCH] sem_attr.adb (Analyze_Access_Attribute): Fix missing set of Address_Taken. 2007-09-26 Robert Dewar * sem_attr.adb (Analyze_Access_Attribute): Fix missing set of Address_Taken. From-SVN: r128801 --- gcc/ada/sem_attr.adb | 43 +++++++++++++++++++++++++++++++------------ 1 file changed, 31 insertions(+), 12 deletions(-) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 1b6863bdd11..903aad050a3 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -707,23 +707,42 @@ package body Sem_Attr is end; end if; - -- Special cases when prefix is entity name + -- Special cases when we can find a prefix that is an entity name - if Is_Entity_Name (P) then + declare + PP : Node_Id; + Ent : Entity_Id; - -- If we have an access to an object, and the attribute comes from - -- source, then set the object as potentially source modified. We - -- do this because the resulting access pointer can be used to - -- modify the variable, and we might not detect this, leading to - -- some junk warnings. + begin + PP := P; + loop + if Is_Entity_Name (PP) then + Ent := Entity (PP); - Set_Never_Set_In_Source (Entity (P), False); + -- If we have an access to an object, and the attribute + -- comes from source, then set the object as potentially + -- source modified. We do this because the resulting access + -- pointer can be used to modify the variable, and we might + -- not detect this, leading to some junk warnings. - -- Mark entity as address taken, and kill current values + Set_Never_Set_In_Source (Ent, False); - Set_Address_Taken (Entity (P)); - Kill_Current_Values (Entity (P)); - end if; + -- Mark entity as address taken, and kill current values + + Set_Address_Taken (Ent); + Kill_Current_Values (Ent); + exit; + + elsif Nkind (PP) = N_Selected_Component + or else Nkind (PP) = N_Indexed_Component + then + PP := Prefix (PP); + + else + exit; + end if; + end loop; + end; -- Check for aliased view unless unrestricted case. We allow a -- nonaliased prefix when within an instance because the prefix may -- 2.30.2