trans.c (lvalue_required_p): Take base node directly instead of its parent.

	* trans.c (lvalue_required_p): Take base node directly instead
	of its parent.  Rename second parameter to 'gnu_type'.
	<N_Indexed_Component>: Return 0 if the node isn't the prefix.
	<N_Slice>: Likewise.
	(Identifier_to_gnu): Rename parent_requires_lvalue to require_lvalue.
	Adjust calls to lvalue_required_p.

From-SVN: r130626

4 files changed, 94 insertions, 51 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0fcdaad..e3dc3bd 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2007-12-05  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* trans.c (lvalue_required_p): Take base node directly instead
+	of its parent.  Rename second parameter to 'gnu_type'.
+	<N_Indexed_Component>: Return 0 if the node isn't the prefix.
+	<N_Slice>: Likewise.
+	(Identifier_to_gnu): Rename parent_requires_lvalue to require_lvalue.
+	Adjust calls to lvalue_required_p.
+
 2007-12-05  Samuel Tardieu  <sam@rfc1149.net>
 
 	PR ada/21489
diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index 9f7ea2e..119d9e8 100644
--- a/gcc/ada/trans.c
+++ b/gcc/ada/trans.c
@@ -379,22 +379,29 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
   error_gnat_node = Empty;
 }
 
-/* Returns a positive value if GNAT_NODE requires an lvalue for an
-   operand of OPERAND_TYPE, whose aliasing is specified by ALIASED,
-   zero otherwise.  This is int instead of bool to facilitate usage
-   in non purely binary logic contexts.  */
+/* Return a positive value if an lvalue is required for GNAT_NODE.
+   GNU_TYPE is the type that will be used for GNAT_NODE in the
+   translated GNU tree.  ALIASED indicates whether the underlying
+   object represented by GNAT_NODE is aliased in the Ada sense.
+
+   The function climbs up the GNAT tree starting from the node and
+   returns 1 upon encountering a node that effectively requires an
+   lvalue downstream.  It returns int instead of bool to facilitate
+   usage in non purely binary logic contexts.  */
 
 static int
-lvalue_required_p (Node_Id gnat_node, tree operand_type, int aliased)
+lvalue_required_p (Node_Id gnat_node, tree gnu_type, int aliased)
 {
-  switch (Nkind (gnat_node))
+  Node_Id gnat_parent = Parent (gnat_node), gnat_temp;
+
+  switch (Nkind (gnat_parent))
     {
     case N_Reference:
       return 1;
 
     case N_Attribute_Reference:
       {
-	unsigned char id = Get_Attribute_Id (Attribute_Name (gnat_node));
+	unsigned char id = Get_Attribute_Id (Attribute_Name (gnat_parent));
 	return id == Attr_Address
 	       || id == Attr_Access
 	       || id == Attr_Unchecked_Access
@@ -404,32 +411,36 @@ lvalue_required_p (Node_Id gnat_node, tree operand_type, int aliased)
     case N_Parameter_Association:
     case N_Function_Call:
     case N_Procedure_Call_Statement:
-      return must_pass_by_ref (operand_type)
-	     || default_pass_by_ref (operand_type);
+      return (must_pass_by_ref (gnu_type) || default_pass_by_ref (gnu_type));
 
     case N_Indexed_Component:
-      {
-	Node_Id gnat_temp;
-	/* ??? Consider that referencing an indexed component with a
-	   non-constant index forces the whole aggregate to memory.
-	   Note that N_Integer_Literal is conservative, any static
-	   expression in the RM sense could probably be accepted.  */
-	for (gnat_temp = First (Expressions (gnat_node));
-	     Present (gnat_temp);
-	     gnat_temp = Next (gnat_temp))
-	  if (Nkind (gnat_temp) != N_Integer_Literal)
-	    return 1;
-      }
+      /* Only the array expression can require an lvalue.  */
+      if (Prefix (gnat_parent) != gnat_node)
+	return 0;
+
+      /* ??? Consider that referencing an indexed component with a
+	 non-constant index forces the whole aggregate to memory.
+	 Note that N_Integer_Literal is conservative, any static
+	 expression in the RM sense could probably be accepted.  */
+      for (gnat_temp = First (Expressions (gnat_parent));
+	   Present (gnat_temp);
+	   gnat_temp = Next (gnat_temp))
+	if (Nkind (gnat_temp) != N_Integer_Literal)
+	  return 1;
 
       /* ... fall through ... */
 
     case N_Slice:
-      aliased |= Has_Aliased_Components (Etype (Prefix (gnat_node)));
-      return lvalue_required_p (Parent (gnat_node), operand_type, aliased);
+      /* Only the array expression can require an lvalue.  */
+      if (Prefix (gnat_parent) != gnat_node)
+	return 0;
+
+      aliased |= Has_Aliased_Components (Etype (gnat_node));
+      return lvalue_required_p (gnat_parent, gnu_type, aliased);
 
     case N_Selected_Component:
-      aliased |= Is_Aliased (Entity (Selector_Name (gnat_node)));
-      return lvalue_required_p (Parent (gnat_node), operand_type, aliased);
+      aliased |= Is_Aliased (Entity (Selector_Name (gnat_parent)));
+      return lvalue_required_p (gnat_parent, gnu_type, aliased);
 
     case N_Object_Renaming_Declaration:
       /* We need to make a real renaming only if the constant object is
@@ -439,8 +450,8 @@ lvalue_required_p (Node_Id gnat_node, tree operand_type, int aliased)
 	 attached to the CONST_DECL.  */
       return (aliased != 0
 	      /* This should match the constant case of the renaming code.  */
-	      || Is_Composite_Type (Etype (Name (gnat_node)))
-	      || Nkind (Name (gnat_node)) == N_Identifier);
+	      || Is_Composite_Type (Etype (Name (gnat_parent)))
+	      || Nkind (Name (gnat_parent)) == N_Identifier);
 
     default:
       return 0;
@@ -450,20 +461,19 @@ lvalue_required_p (Node_Id gnat_node, tree operand_type, int aliased)
 }
 
 /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Identifier,
-   to a GCC tree, which is returned.  GNU_RESULT_TYPE_P is a pointer to
-   where we should place the result type.  */
+   to a GCC tree, which is returned.  GNU_RESULT_TYPE_P is a pointer
+   to where we should place the result type.  */
 
 static tree
 Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 {
-  tree gnu_result_type;
-  tree gnu_result;
   Node_Id gnat_temp, gnat_temp_type;
+  tree gnu_result, gnu_result_type;
 
-  /* Whether the parent of gnat_node requires an lvalue.  Needed in
-     specific circumstances only, so evaluated lazily.  < 0 means unknown,
-     > 0 means known true, 0 means known false.  */
-  int parent_requires_lvalue = -1;
+  /* Whether we should require an lvalue for GNAT_NODE.  Needed in
+     specific circumstances only, so evaluated lazily.  < 0 means
+     unknown, > 0 means known true, 0 means known false.  */
+  int require_lvalue = -1;
 
   /* If GNAT_NODE is a constant, whether we should use the initialization
      value instead of the constant entity, typically for scalars with an
@@ -539,9 +549,9 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
   gnu_result_type = get_unpadded_type (gnat_temp_type);
 
   /* If this is a non-imported scalar constant with an address clause,
-     retrieve the value instead of a pointer to be dereferenced unless the
-     parent requires an lvalue.  This is generally more efficient and
-     actually required if this is a static expression because it might be used
+     retrieve the value instead of a pointer to be dereferenced unless
+     an lvalue is required.  This is generally more efficient and actually
+     required if this is a static expression because it might be used
      in a context where a dereference is inappropriate, such as a case
      statement alternative or a record discriminant.  There is no possible
      volatile-ness shortciruit here since Volatile constants must be imported
@@ -550,10 +560,9 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
       && !Is_Imported (gnat_temp)
       && Present (Address_Clause (gnat_temp)))
     {
-      parent_requires_lvalue
-	= lvalue_required_p (Parent (gnat_node), gnu_result_type,
-			     Is_Aliased (gnat_temp));
-      use_constant_initializer = !parent_requires_lvalue;
+      require_lvalue = lvalue_required_p (gnat_node, gnu_result_type,
+					  Is_Aliased (gnat_temp));
+      use_constant_initializer = !require_lvalue;
     }
 
   if (use_constant_initializer)
@@ -646,21 +655,21 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
      of places and the need of elaboration code if this Id is used as
      an initializer itself.  */
   if (TREE_CONSTANT (gnu_result)
-      && DECL_P (gnu_result) && DECL_INITIAL (gnu_result))
+      && DECL_P (gnu_result)
+      && DECL_INITIAL (gnu_result))
     {
       tree object
 	= (TREE_CODE (gnu_result) == CONST_DECL
 	   ? DECL_CONST_CORRESPONDING_VAR (gnu_result) : gnu_result);
 
-      /* If there is a corresponding variable, we only want to return the CST
-	 value if the parent doesn't require an lvalue.  Evaluate this now if
-	 we have not already done so.  */
-      if (object && parent_requires_lvalue < 0)
-	parent_requires_lvalue
-	  = lvalue_required_p (Parent (gnat_node), gnu_result_type,
-			       Is_Aliased (gnat_temp));
+      /* If there is a corresponding variable, we only want to return
+	 the CST value if an lvalue is not required.  Evaluate this
+	 now if we have not already done so.  */
+      if (object && require_lvalue < 0)
+	require_lvalue = lvalue_required_p (gnat_node, gnu_result_type,
+					    Is_Aliased (gnat_temp));
 
-      if (!object || !parent_requires_lvalue)
+      if (!object || !require_lvalue)
 	gnu_result = unshare_expr (DECL_INITIAL (gnu_result));
     }
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 47b6a72..04c8ebf 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2007-12-05  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/specs/elab1.ads: New test.
+
 2007-12-05  Uros Bizjak  <ubizjak@gmail.com>
 
 	PR target/34312
diff --git a/gcc/testsuite/gnat.dg/specs/elab1.ads b/gcc/testsuite/gnat.dg/specs/elab1.ads
new file mode 100644
index 0000000..ac435d7
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/elab1.ads
@@ -0,0 +1,21 @@
+-- { dg-do compile }
+
+pragma Restrictions(No_Elaboration_Code);
+
+with System;
+
+package Elab1 is
+
+   type Ptrs_Type is array (Integer range 1 .. 2) of System.Address;
+   type Vars_Array is array (Integer range 1 .. 2) of Integer;
+
+   Vars : Vars_Array;
+
+   Val1 : constant Integer := 1;
+   Val2 : constant Integer := 2;
+
+   Ptrs : constant Ptrs_Type :=
+     (1  => Vars (Val1)'Address,
+      2  => Vars (Val2)'Address);
+
+end Elab1;