2007-08-14 Robert Dewar <dewar@adacore.com>

	    Gary Dismukes  <dismukes@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>
	    Thomas Quinot  <quinot@adacore.com>

	* a-stzsup.adb, nlists.adb, lib-util.adb, treepr.adb, 
	a-stwisu.adb, a-strsup.adb: Fix warnings for range
	tests optimized out.

	* exp_ch4.adb (Expand_N_In): Add warnings for range tests optimized out.
	(Get_Allocator_Final_List): For the case of an anonymous access type
	that has a specified Associated_Final_Chain, do not go up to the
	enclosing scope.
	(Expand_N_Type_Conversion): Test for the case of renamings of access
	parameters when deciding whether to apply a run-time accessibility
	check.
	(Convert_Aggr_In_Allocator): Use Insert_Actions to place expanded
	aggregate code before allocator, and ahead of declaration for
	temporary, to prevent access before elaboration when the allocator is
	an actual for an access parameter.
	(Expand_N_Type_Conversion): On an access type conversion involving an
	access parameter, do not apply an accessibility check when the
	operand's original node was an attribute other than 'Access. We now
	create access conversions for the expansion of 'Unchecked_Access and
	'Unrestricted_Access in certain cases and clearly accessibility should
	not be checked for those.

	* exp_ch6.ads, exp_ch6.adb (Add_Call_By_Copy_Code): For an actual that
	includes a type conversion of a packed component that has been expanded,
	recover the original expression for the object, and use this expression
	in the post-call assignment statement, so that the assignment is made
	to the object and not to a back-end temporary.
	(Freeze_Subprogram): In case of primitives of tagged types not defined
	at the library level force generation of code to register the primitive
	in the dispatch table. In addition some code reorganization has been
	done to leave the implementation clear.
	(Expand_Call): When expanding an inherited implicit conversion,
	preserve the type of the inherited function after the intrinsic
	operation has been expanded.

	* exp_ch2.ads, exp_ch2.adb
	(Expand_Entry_Parameter.In_Assignment_Context): An implicit dereference
	of an entry formal appearing in an assignment statement does not assign
	to the formal.
	(Expand_Current_Value): Instead of calling a routine to determine
	whether the prefix of an attribute reference should be optimized or
	not, prevent the optimization of such prefixes all together.

	* lib-xref.adb (Generate_Reference.Is_On_LHS): An indexed or selected
	component whose prefix is known to be of an access type is an implicit
	dereference and does not assign to the prefix.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127411 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 29 insertions, 8 deletions

diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index ec47ff95f7f..15755a56f84 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -223,13 +223,20 @@ package body Lib.Xref is
       --   Prefix    Of an indexed or selected component that is present in a
       --             subtree rooted by an assignment statement. There is no
       --             restriction of nesting of components, thus cases such as
-      --             A.B(C).D are handled properly.
+      --             A.B (C).D are handled properly.
+      --             However a prefix of a dereference (either implicit or
+      --             explicit) is never considered as on a LHS.
 
       ---------------
       -- Is_On_LHS --
       ---------------
 
-      --  Couldn't we use Is_Lvalue or whatever it is called ???
+      --  ??? There are several routines here and there that perform a similar
+      --      (but subtly different) computation, which should be factored:
+
+      --      Sem_Util.May_Be_Lvalue
+      --      Sem_Util.Known_To_Be_Assigned
+      --      Exp_Ch2.Expand_Entry_Parameter.In_Assignment_Context
 
       function Is_On_LHS (Node : Node_Id) return Boolean is
          N : Node_Id := Node;
@@ -247,13 +254,28 @@ package body Lib.Xref is
 
          while Nkind (Parent (N)) /= N_Assignment_Statement loop
 
-            --  Check whether the parent is a component and the
-            --  current node is its prefix.
+            --  Check whether the parent is a component and the current node
+            --  is its prefix, but return False if the current node has an
+            --  access type, as in that case the selected or indexed component
+            --  is an implicit dereference, and the LHS is the designated
+            --  object, not the access object.
+
+            --  ??? case of a slice assignment?
+
+            --  ??? Note that in some cases this is called too early
+            --  (see comments in Sem_Ch8.Find_Direct_Name), at a point where
+            --  the tree is not fully typed yet. In that case we may lack
+            --  an Etype for N, and we must disable the check for an implicit
+            --  dereference. If the dereference is on an LHS, this causes a
+            --  false positive.
 
             if (Nkind (Parent (N)) = N_Selected_Component
                   or else
                 Nkind (Parent (N)) = N_Indexed_Component)
               and then Prefix (Parent (N)) = N
+              and then not (Present (Etype (N))
+                              and then
+                            Is_Access_Type (Etype (N)))
             then
                N := Parent (N);
             else
@@ -370,7 +392,7 @@ package body Lib.Xref is
          --  a left hand side. We also set the Referenced_As_LHS flag of a
          --  prefix of selected or indexed component.
 
-         if Ekind (E) = E_Variable
+         if (Ekind (E) = E_Variable or else Is_Formal (E))
            and then Is_On_LHS (N)
          then
             Set_Referenced_As_LHS (E);
@@ -1004,9 +1026,8 @@ package body Lib.Xref is
                end if;
             end if;
 
-            --  Collect inherited primitive operations that may be
-            --  declared in another unit and have no visible reference
-            --  in the current one.
+            --  Collect inherited primitive operations that may be declared in
+            --  another unit and have no visible reference in the current one.
 
             if Is_Type (Ent)
               and then Is_Tagged_Type (Ent)