decl.c (array_type_has_nonaliased_component): Swap parameters and rewrite comments.

	* gcc-interface/decl.c (array_type_has_nonaliased_component): Swap
	parameters and rewrite comments.  For a derived type, return the
	setting of its parent type.
	(gnat_to_gnu_entity): Do an alias set copy for derived types if they
	are composite.  Adjust calls to above function.

From-SVN: r153721

gcc/ada/ChangeLog

 2009-10-29  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gcc-interface/decl.c (array_type_has_nonaliased_component): Swap
+	parameters and rewrite comments.  For a derived type, return the
+	setting of its parent type.
+	(gnat_to_gnu_entity): Do an alias set copy for derived types if they
+	are composite.  Adjust calls to above function.
+
+2009-10-29  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Object_Size>: Do not
 	return the RM size for padded types.
 

gcc/ada/gcc-interface/decl.c

@@ -135,7 +135,7 @@ static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool,
 			       bool *);
 static tree gnat_to_gnu_field (Entity_Id, tree, int, bool, bool);
 static bool same_discriminant_p (Entity_Id, Entity_Id);
-static bool array_type_has_nonaliased_component (Entity_Id, tree);
+static bool array_type_has_nonaliased_component (tree, Entity_Id);
 static bool compile_time_known_address_p (Node_Id);
 static bool cannot_be_superflat_p (Node_Id);
 static void components_to_record (tree, Node_Id, tree, int, bool, tree *,
@@ -1963,7 +1963,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	  {
 	    tem = build_array_type (tem, gnu_index_types[index]);
 	    TYPE_MULTI_ARRAY_P (tem) = (index > 0);
-	    if (array_type_has_nonaliased_component (gnat_entity, tem))
+	    if (array_type_has_nonaliased_component (tem, gnat_entity))
 	      TYPE_NONALIASED_COMPONENT (tem) = 1;
 	  }
 
@@ -2312,7 +2312,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    {
 	      gnu_type = build_array_type (gnu_type, gnu_index_types[index]);
 	      TYPE_MULTI_ARRAY_P (gnu_type) = (index > 0);
-	      if (array_type_has_nonaliased_component (gnat_entity, gnu_type))
+	      if (array_type_has_nonaliased_component (gnu_type, gnat_entity))
 		TYPE_NONALIASED_COMPONENT (gnu_type) = 1;
 	    }
 
@@ -2563,7 +2563,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	gnu_type
 	  = build_array_type (gnat_to_gnu_type (Component_Type (gnat_entity)),
 			      gnu_index_type);
-	if (array_type_has_nonaliased_component (gnat_entity, gnu_type))
+	if (array_type_has_nonaliased_component (gnu_type, gnat_entity))
 	  TYPE_NONALIASED_COMPONENT (gnu_type) = 1;
 	relate_alias_sets (gnu_type, gnu_string_type, ALIAS_SET_COPY);
       }
@@ -4602,11 +4602,38 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		   superset      superset
 		R ----------> D ----------> T
 
+	 However, for composite types, conversions between derived types are
+	 translated into VIEW_CONVERT_EXPRs so a sequence like:
+
+	    type Comp1 is new Comp;
+	    type Comp2 is new Comp;
+	    procedure Proc (C : Comp1);
+
+	    C : Comp2;
+	    Proc (Comp1 (C));
+
+	 is translated into:
+
+	    C : Comp2;
+	    Proc ((Comp1 &) &VIEW_CONVERT_EXPR <Comp1> (C));
+
+	 and gimplified into:
+
+	    C : Comp2;
+	    Comp1 *C.0;
+	    C.0 = (Comp1 *) &C;
+	    Proc (C.0);
+
+	 i.e. generates code involving type punning.  Therefore, Comp1 needs
+	 to conflict with Comp2 and an alias set copy is required.
+
 	 The language rules ensure the parent type is already frozen here.  */
       if (Is_Derived_Type (gnat_entity))
 	{
 	  tree gnu_parent_type = gnat_to_gnu_type (Etype (gnat_entity));
-	  relate_alias_sets (gnu_type, gnu_parent_type, ALIAS_SET_SUPERSET);
+	  relate_alias_sets (gnu_type, gnu_parent_type,
+			     Is_Composite_Type (gnat_entity)
+			     ? ALIAS_SET_COPY : ALIAS_SET_SUPERSET);
 	}
 
       /* Back-annotate the Alignment of the type if not already in the
@@ -5254,21 +5281,38 @@ same_discriminant_p (Entity_Id discr1, Entity_Id discr2)
     Original_Record_Component (discr1) == Original_Record_Component (discr2);
 }
 
-/* Return true if the array type specified by GNAT_TYPE and GNU_TYPE has
-   a non-aliased component in the back-end sense.  */
+/* Return true if the array type GNU_TYPE, which represents a dimension of
+   GNAT_TYPE, has a non-aliased component in the back-end sense.  */
 
 static bool
-array_type_has_nonaliased_component (Entity_Id gnat_type, tree gnu_type)
+array_type_has_nonaliased_component (tree gnu_type, Entity_Id gnat_type)
 {
-  /* If the type below this is a multi-array type, then
-     this does not have aliased components.  */
+  /* If the array type is not the innermost dimension of the GNAT type,
+     then it has a non-aliased component.  */
   if (TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE
       && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type)))
     return true;
 
+  /* If the array type has an aliased component in the front-end sense,
+     then it also has an aliased component in the back-end sense.  */
   if (Has_Aliased_Components (gnat_type))
     return false;
 
+  /* If this is a derived type, then it has a non-aliased component if
+     and only if its parent type also has one.  */
+  if (Is_Derived_Type (gnat_type))
+    {
+      tree gnu_parent_type = gnat_to_gnu_type (Etype (gnat_type));
+      int index;
+      if (TREE_CODE (gnu_parent_type) == UNCONSTRAINED_ARRAY_TYPE)
+	gnu_parent_type
+	  = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_parent_type))));
+      for (index = Number_Dimensions (gnat_type) - 1; index > 0; index--)
+	gnu_parent_type = TREE_TYPE (gnu_parent_type);
+      return TYPE_NONALIASED_COMPONENT (gnu_parent_type);
+    }
+
+  /* Otherwise, rely exclusively on properties of the element type.  */
   return type_for_nonaliased_component_p (TREE_TYPE (gnu_type));
 }