exp_ch4.adb (Expand_N_Indexed_Component): For an indexed component with an…

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

@@ -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

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;
 

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);