decl.c (gnat_to_gnu_entity): Simplify the condition under which a constant…

decl.c (gnat_to_gnu_entity): Simplify the condition under which a constant renaming is treated as a normal...

	* decl.c (gnat_to_gnu_entity) <Object>: Simplify the condition under
	which a constant renaming is treated as a normal object declaration.
	* trans.c (lvalue_required_p) <N_Slice>: New case, extracted from
	the N_Indexed_Component case.
	<N_Indexed_Component>: Fall through to above case.
	<N_Object_Renaming_Declaration>: Return true for all composite types.

From-SVN: r128268

gcc/ada/ChangeLog

 2007-09-08  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* decl.c (gnat_to_gnu_entity) <Object>: Simplify the condition under
+	which a constant renaming is treated as a normal object declaration.
+	* trans.c (lvalue_required_p) <N_Slice>: New case, extracted from
+	the N_Indexed_Component case.
+	<N_Indexed_Component>: Fall through to above case.
+	<N_Object_Renaming_Declaration>: Return true for all composite types.
+
+2007-09-08  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* decl.c (make_packable_type): If the new type has been given BLKmode,
 	try again to get an integral mode for it.
 

gcc/ada/decl.c

@@ -815,10 +815,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		/* Case 3: If this is a constant renaming and creating a
 		   new object is allowed and cheap, treat it as a normal
 		   object whose initial value is what is being renamed.  */
-		if (const_flag
-		    && Ekind (Etype (gnat_entity)) != E_Class_Wide_Type
-		    && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
-		    && TYPE_MODE (gnu_type) != BLKmode)
+		if (const_flag && Is_Elementary_Type (Etype (gnat_entity)))
 		  ;
 
 		/* Case 4: Make this into a constant pointer to the object we

gcc/ada/trans.c

@@ -384,20 +384,28 @@ lvalue_required_p (Node_Id gnat_node, tree operand_type, int aliased)
 	     gnat_temp = Next (gnat_temp))
 	  if (Nkind (gnat_temp) != N_Integer_Literal)
 	    return 1;
-	aliased |= Has_Aliased_Components (Etype (Prefix (gnat_node)));
-	return lvalue_required_p (Parent (gnat_node), operand_type, aliased);
       }
 
+      /* ... fall through ... */
+
+    case N_Slice:
+      aliased |= Has_Aliased_Components (Etype (Prefix (gnat_node)));
+      return lvalue_required_p (Parent (gnat_node), operand_type, aliased);
+
     case N_Selected_Component:
       aliased |= Is_Aliased (Entity (Selector_Name (gnat_node)));
       return lvalue_required_p (Parent (gnat_node), operand_type, aliased);
 
     case N_Object_Renaming_Declaration:
       /* We need to make a real renaming only if the constant object is
-	 aliased; otherwise we can optimize and return the rvalue.  We
-	 make an exception if the object is an identifier since in this
-	 case the rvalue can be propagated attached to the CONST_DECL.  */
-      return aliased || Nkind (Name (gnat_node)) == N_Identifier;
+	 aliased or if we may use a renaming pointer; otherwise we can
+	 optimize and return the rvalue.  We make an exception if the object
+	 is an identifier since in this case the rvalue can be propagated
+	 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);
 
     default:
       return 0;

gcc/testsuite/ChangeLog

 2007-09-08  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gnat.dg/renaming3.adb, renaming4.ads: New test.
+
+2007-09-08  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gnat.dg/unaligned_rep_clause.adb: New testcase.
 
 2007-09-08  Dorit Nuzman  <dorit@il.ibm.com>

gcc/testsuite/gnat.dg/renaming3.adb

+-- { dg-do run }
+
+with Renaming4; use Renaming4;
+
+procedure Renaming3 is
+   type A is array(1..16) of Integer;
+   Filler : A := (others => 0);
+begin
+   if B(1) /= 1 then
+      raise Program_Error;
+   end if;
+end;

gcc/testsuite/gnat.dg/renaming4.ads

+package Renaming4 is
+
+   type Big_Array is array (Natural range <>) of Integer;
+
+   subtype Index is Natural range 1..4;
+   subtype My_Array is Big_Array(Index);
+
+   A : constant My_Array := (1, 2, 3, 4);
+
+   subtype Small is Index range 1..2;
+   subtype Small_Array is Big_Array(Small);
+
+   B : Small_Array renames A(Index);
+
+end Renaming4;