From 2717634daab64ed32a49b329f61cf0064f80f046 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 8 Dec 2004 12:26:46 +0100 Subject: [PATCH] exp_ch4.adb (Expand_N_Indexed_Component): For an indexed component with an implicit dereference as its prefix... * exp_ch4.adb (Expand_N_Indexed_Component): For an indexed component with an implicit dereference as its prefix, use Insert_Explicit_Dereference instead of merely rewriting the prefix into an explicit dereference. This ensures that a reference to the original prefix is generated, if appropriate. * sem_util.adb (Insert_Explicit_Dereference): When an implicit dereference is rewritten to an explicit one, generate a reference to the entity denoted by its prefix using the original prefix node, so the dereference can be properly recorded as a read of the denoted access value, if appropriate. * sem_warn.adb (Output_Unreferenced_Messages): Do not abstain from emitting 'assigned but never read' warning on a variable on the basis that it has an access type. (Check_References): Emit unreferenced warning when the scope is a subprogram body. From-SVN: r91881 --- gcc/ada/exp_ch4.adb | 12 +++++------- gcc/ada/sem_util.adb | 18 +++++++++++++++++- gcc/ada/sem_warn.adb | 20 ++++++-------------- 3 files changed, 28 insertions(+), 22 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index be053b59ddd..67fc5e80640 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -1780,7 +1780,7 @@ package body Exp_Ch4 is -- end loop; -- end if; - -- ... + -- . . . -- if Sn'Length /= 0 then -- P := Sn'First; @@ -2914,7 +2914,7 @@ package body Exp_Ch4 is -- Cnn := else-expr -- end if; - -- and replace the conditional expression by a reference to Cnn. + -- and replace the conditional expression by a reference to Cnn if Present (Then_Actions (N)) or else Present (Else_Actions (N)) then Cnn := Make_Defining_Identifier (Loc, New_Internal_Name ('C')); @@ -3273,9 +3273,7 @@ package body Exp_Ch4 is -- was necessary, but it cleans up the code to do it all the time. if Is_Access_Type (T) then - Rewrite (P, - Make_Explicit_Dereference (Sloc (N), - Prefix => Relocate_Node (P))); + Insert_Explicit_Dereference (P); Analyze_And_Resolve (P, Designated_Type (T)); end if; @@ -3921,7 +3919,7 @@ package body Exp_Ch4 is -- Obj1 : Enclosing_UU_Type; -- Obj2 : Enclosing_UU_Type (1); - -- . . . Obj1 = Obj2 . . . + -- [. . .] Obj1 = Obj2 [. . .] -- Generated code: @@ -6735,7 +6733,7 @@ package body Exp_Ch4 is -- ityp (x) - -- with the Float_Truncate flag set. This is clearly more efficient. + -- with the Float_Truncate flag set. This is clearly more efficient if Nkind (Operand) = N_Attribute_Reference and then Attribute_Name (Operand) = Name_Truncation diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 22066fe07ce..cc0cc6fd43b 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -2631,7 +2631,7 @@ package body Sem_Util is begin Get_Unit_Name_String (Unit_Name_Id); - -- Remove seven last character (" (spec)" or " (body)"). + -- Remove seven last character (" (spec)" or " (body)") Name_Len := Name_Len - 7; pragma Assert (Name_Buffer (Name_Len + 1) = ' '); @@ -3136,6 +3136,7 @@ package body Sem_Util is procedure Insert_Explicit_Dereference (N : Node_Id) is New_Prefix : constant Node_Id := Relocate_Node (N); + Ent : Entity_Id := Empty; I : Interp_Index; It : Interp; T : Entity_Id; @@ -3166,6 +3167,21 @@ package body Sem_Util is end loop; End_Interp_List; + + else + -- Prefix is unambiguous: mark the original prefix (which might + -- Come_From_Source) as a reference, since the new (relocated) one + -- won't be taken into account. + + if Is_Entity_Name (New_Prefix) then + Ent := Entity (New_Prefix); + elsif Nkind (New_Prefix) = N_Selected_Component then + Ent := Entity (Selector_Name (New_Prefix)); + end if; + + if Present (Ent) then + Generate_Reference (Ent, New_Prefix); + end if; end if; end Insert_Explicit_Dereference; diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index ba4c957327e..371060669cb 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -563,6 +563,7 @@ package body Sem_Warn is (Ekind (E) = E_Function or else Ekind (E) = E_Package_Body or else Ekind (E) = E_Procedure + or else Ekind (E) = E_Subprogram_Body or else Ekind (E) = E_Block))) -- Exclude instantiations, since there is no reason why @@ -670,7 +671,7 @@ package body Sem_Warn is Unreferenced_Entities.Increment_Last; Unreferenced_Entities.Table (Unreferenced_Entities.Last) := E1; - -- Force warning on entity. + -- Force warning on entity Set_Referenced (E1, False); end if; @@ -994,7 +995,7 @@ package body Sem_Warn is Un : constant Node_Id := Sinfo.Unit (Cnode); function Check_Use_Clause (N : Node_Id) return Traverse_Result; - -- If N is a use_clause for Pack, emit warning. + -- If N is a use_clause for Pack, emit warning procedure Check_Use_Clauses is new Traverse_Proc (Check_Use_Clause); @@ -1484,22 +1485,13 @@ package body Sem_Warn is if Warn_On_Modified_Unread and then not Is_Imported (E) - -- Suppress the message for aliased, renamed - -- and access variables since there may be - -- other entities that read the memory location. + -- Suppress the message for aliased or renamed + -- variables, since there may be other entities + -- read the same memory location. and then not Is_Aliased (E) and then No (Renamed_Object (E)) - and then not (Is_Access_Type (Etype (E)) - or else - -- Case of private access type, must examine the - -- full view due to visibility issues. - - (Is_Private_Type (Etype (E)) - and then - Is_Access_Type - (Full_View (Etype (E))))) then Error_Msg_N ("variable & is assigned but never read?", E); -- 2.30.2